perm filename MUSIC.FAI[COL,LCS] blob
sn#105205 filedate 1974-05-31 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00055 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00006 00002 ****** AS OF JAN. 12, 1971 *********
00500 C00012 00003 INPUT ROUTINE. CALL INITIALLY WITH PUSHJ P,SETUP
00600 C00015 00004 RIN: ILDB TIB+1 GET FILE NAME
00700 C00017 00005 AER1: MOVEI DEV1MS ERROR ROUTINE FOR NOT AVAILABLE
00800 C00019 00006 SIXOUT: TLO 440600 MAKE BYTE POINTER
00900 C00021 00007 SUBTTL ALGOL SCANNER -- 9/8/66 D. POOLE
01000 C00024 00008 MOVE A,ACCUM PREPARE TO SEARCH TABLES.
01100 C00027 00009 FOOSCH: LDB B,[POINT 6,ACCUM,17]
01200 C00029 00010 SNUM1: MOVEI C,0 NUMBER SCANNER.
01300 C00031 00011 NOW SEARCH NUMBER TABLE FOR THE NUMBER.
01400 C00033 00012 RESERVED WORD TABLE SEARCHER.
01500 C00035 00013 THE CHARACTER CONVERSION TABLE -- GOOD BITS FOR EVERYONE !
01600 C00037 00014 DEFINE PUT1 (N,Y)
01700 C00039 00015 MORE BITS AND PARAMETERS.
01800 C00041 00016 TEMPSY: EXP TMPS1Z
01900 C00047 00017 TMPSA: EXP TMPS4 LINEN.
02000 C00049 00018 HERE ARE SOME WONDERFUL UNIT GENERATORS.
02100 C00057 00019 REVERBERATION UNIT GENERATORS.
02200 C00061 00020 MORE GENERATORS.
02300 C00064 00021 RANDOM NUMBER GENERATORS.
02400 C00067 00022 PLIST: BLOCK LPLIST
02500 C00068 00023 THIS IS THE MULTIPLE-FEEDBACK REVERBERATOR.
02600 C00070 00024
02700 C00073 00025 ***** COMPX BEGINS HERE **** ROUTINES TO EMIT CODE AND STUFF TO OUTPUT BUFFERS.
02800 C00076 00026 THIS HERE IS THE COMPILER !
02900 C00078 00027 PRIM2: CAMN A,MINV UNARY MINUS ?
03000 C00081 00028 PROCESS A FUNCTION CALL.
03100 C00084 00029 HERE ARE THE GLORIOUS, SUPER-INTELLIGENT, SCHIZOPHRENIC
03200 C00087 00030 HA! I BET YOU THOUGHT WE WERE DONE, DIDN'T YOU ?
03300 C00089 00031 GMURK CLEVERLY GPONDERS THE TOP TWO OPERANDS,
03400 C00092 00032 STILL MORE KLUGES. PAUSE TO GET YOUR BREATH NOW.
03500 C00095 00033 GETAC SEARCHES FOR A FREE AC, EITHER I-TIME OR
03600 C00098 00034 MORE GENERATORS.
03700 C00100 00035 GFUNC: GENERATE A FUNCTION CALL.
03800 C00103 00036 UTILITY RUOTINE TO ENTER AN ITEM IN THE MAIN SYMBOL TAB.
03900 C00106 00037 INITIALIZATION OF THE COMPILER.
04000 C00108 00038 SYNTAX ANALYZER.
04100 C00111 00039
04200 C00113 00040 DF5: CAME A,COMMAV ARE THERE MORE DEFINITIONS ?
04300 C00116 00041 DF2A: TLNE A,DF+NUMFLG
04400 C00119 00042 MORE SYNTAX ANALYZER. COMPILE AN INSTRUMENT DEFINITION.
04500 C00123 00043 CINS4: PUSHJ P,STMT1 ITS NOT A UNIT GEN. CALL.
04600 C00127 00044 THE WONDERFUL, WINNING LOADER.
04700 C00130 00045 MORE LOADER (BUT NOT MUCH MORE, YOU WILL NOTICE !).
04800 C00132 00046 DARR: PUSH P,[0] DEFINE SOME ARRAYS.
04900 C00135 00047 HERE IS THE OUTER LOOP OF THE WHOLE SYSTEM.
05000 C00138 00048 THIS CODE READS A NOTE STATEMENT, INITIALIZES THE
05100 C00141 00049 MORE OF PINS.
05200 C00143 00050 THIS ROUTINE GENERATES SAMPLES BY CALLING THE
05300 C00146 00051 RANDOM ROUTINES TO HANDLE THE SAMPLE OUTPUT BUFFER.
05400 C00150 00052 ERROR HANDLING(?) ROUTINES.
05500 C00152 00053
05600 C00153 00054 RDNUM: 0 NUMBER READER FOR FOOTRAN ROUTINES.
05700 C00155 00055 REST1: MOVEI TEMPSY
05800 C00157 ENDMK
05900 C⊗;
00100 ;;;****** AS OF JAN. 12, 1971 *********
00200 ↓T←1
00300 T1←2
00400 T2←3
00500 T3←4
00600 A←5
00700 B ←6
00800 C←7
00900 D←10
01000 E←11
01100 F←12
01200 H←14
01300 OSP←13
01400 ↓P←15
01500 ↓FL←17
01600 NACS←←5
01700 NFACS←←4
01800 INSXR←←NFACS-1
01900 SSPCF←←10
02000 SDFLG←←20
02100 SNUMF←←40
02200 FIXFLG←←1000
02300 FLTFLG←←2000
02400 DF←←400000
02500 NUMFLG←←FIXFLG+FLTFLG
02600 SSPC2F←←4000
02700
02800 RFLG←←0 ;$$$%%&%$###""##$%$$$$$
02900 DECLBIT←←400
03000 RVBT←←400
03100 PRVBT←←11
03200 MULBIT←←1
03300 ADDBIT←←2
03400 FOOBIT←←100
03500 INSBIT←←40
03600 UGBIT←←4000
03700 FPARBT←←200
03800
03900 SRACBT←←10000
04000 SIACBT←←20000
04100 GPBIT←←FOOBIT ;NOT I OR X.
04200 FUNBIT←←40000
04300 SWVBT←←100000 ;DO NOT CHANGE ! SEE GFUNC.
04400 VRBLBT←←200000
04500 ;; RELOCATION AND FIXUP BITS .
04600 .FXBTS←←1
04700 LFXBTS←←2
04800 VRELBT←←14+1
04900 RRELBT←←4+1
05000 IRELBT←←10+1
05100 ;; FLAGS (RIGHT HALF):
05200 CSBRBT←←1
05300 SFOOBT←←10
05400 USBRBT←←2
05500 GFUNCF←←4
05600 EXTFLG←←40
05700 ARRFLG←←20
05800 RVFLG←←100
05900 RESTART←←200
06000 ;FLAGS (LEFT HALF).
06100 ERRFLG←←1
06200 MINFLG←←2
06300 SNUMF1←←4
06400 NOSTAR←←10
06500 DTFLG←←20
06600 ;; PARAMETER DESCRIPTOR BITS:
06700 FAOPAR←←1
06800 FDPARB←←4
06900 FDPARC←←5
07000
07100 COFF←←1000 ;PI CHANNEL OFF.
07200 CON←←2000
07300 DACHN←←100 ;PI CHANNEL 1.
07400
07500 LRFXBT←←200000 ;LEFT HALF REPLACEMENT FIXUP BIT.
07600 RRFXBT←←100000 ;RIGHT HALF.
07700 SWAPBT←←40000 ;SWAPPED FIXUP.
07800
07900 DEFINE IOWD (A,B) <XWD -A,B-1>
08000 OPDEF EXP [0]
08100 ;**** NO HARDWARE FIX AT CMU
08200 ;OPDEF FIX [XWD 247000,0] ;FOR PDP10 ONLY. REMOVE WITH DDT FOR PDP6
08300 LOC 41
08400 JSR UUOSER
08500 RELOC
08600 OPDEF JRSTF [JRST 2,]
08700 OPDEF FIX [XWD 2000,0]
08800 UUOSER: 0
08900 MOVEM A,SAVEA#
09000 HLRZ A,40
09100 CAIL A,2000
09200 JRST FIXER
09300 MOVE A,SAVEA
09400 JSR ERR1
09500 JRSTF @UUOSER
09600 FIXER: MOVE A,SAVEA
09700 MOVEM P,SAVEP#
09800 LDB P,[POINT 4,40,12]
09900 EXCH B,(P)
10000 MOVEM A,SAVEA
10100 HRLE A,40
10200 UFA A,B
10300 JUMPE B,ZERO
10400 TDC B,A
10500 ZERO: MOVE A,SAVEA
10600 EXCH B,(P)
10700 MOVE P,SAVEP
10800 JRSTF @UUOSER
10900 ;*** END OF FIXER PATCH
11000
11100 OPDEF OUTCHR [XWD 51040,0]
11200
11300 ;****** THIS REQUIRES 'USETI' TO PRESERVE POINTERS TO PROG. WHEN SAVED.
11400 ;BEGIN SAVER
11500 ; (INSERTED 11/3/69)
11600 ; TO DUMP CORE IMAGE
11700 ; CREATE A FILE OF THE CURRENT CORE IMAGE.
11800 ; PICK UP THE USER'S INPUT FILE NAME STORED
11900 ; IN DLK AND CREATE A FILE CALLED:
12000 ; "NAME.SAV"
12100 ; WHERE NAME IS THE INPUT FILE NAME.
12200 ;
12300 ; THE SWAP UU0 WILL BE USED WHICH CLOSES ALL
12400 ; ACTIVE DEVICES.
12500 ;
12600 ; ACCUMULATORS 0 AND T WILL BE CLOBBERED BY THIS
12700 ; ROUTINE. ALL OTHERS WILL BE SAVED AND RESTORED.
12800
12900 ;;INTERNAL SAVER
13000
13100 ;↑SAVER: 0
13200 ; MOVE 0,SCP ;BASE OF INPUT BUFFER
13300 ; HRRZ T,IBUF ;CURRENT BUFFER
13400 ; SUBI 0,-BUF1-1(T) ;DIFFERENCE
13500 ; MOVEM 0,PLIST+LPLIST-10
13600
13700 ; MOVEM 17,ACS+17 ;SAVE REGISTERS
13800 ; MOVEI 17,ACS
13900 ; BLT 17,ACS+16
14000
14100 ; SKIPN T,DLK ;INPUT FILE NAME
14200 ; MOVSI T,'SAV'
14300 ; MOVEM T,SWPTBL+1
14400
14500 ; MOVSI T,SWPTBL ;ADDR OF 5 WORD BLOCK IN LEFT PART OF T
14600 ; CALL T,[SIXBIT /SWAP/]
14700
14800 ;RETR: MOVE P,[XWD -10,PLIST+LPLIST-10] ;PICK UP ACCUM P
14900 ; MOVEI FL,RESTART ;RESTORE RESTART FLAG
15000 ; SOS RECCT; ; ;BACK UP TO PREVIOUS INPUT RECORD.
15100 ; PUSHJ P,SETUP ;JUMP TO RESTORE FILES
15200 ; POP P,SCP
15300 ; MOVEI GO
15400 ; HRRM JOBSA
15500 ; MOVSI 17,ACS ;RESTORE REGISTERS
15600 ; BLT 17,17
15700 ; JRA 16,(16)
15800
15900 ;ACS: BLOCK 20; ;REGISTER SAVE AREA
16000 ;SWPTBL: SIXBIT /DSK/ ;DEVICE FOR SWAP
16100 ; 0; ; ;FOR FILENAME
16200 ; SIXBIT /SAV/ ;FILENAME.SAV
16300 ; RETR ;CORE SIZE (0=USE WHAT YOU NEED)
16400 ; 0; ; ;END OF LIST
16500
16600 ;BEND SAVER
16700
00100 ;INPUT ROUTINE. CALL INITIALLY WITH PUSHJ P,SETUP
00200 ;WILL READIN DTA# AND FILE NAME. GET CHRS BY
00300 ;ILDB IBUF+1. NEXT BUFFER BY INPUT DT,0.
00400 TITLE MUSIC
00500 ;;;EXTERNAL IFIX
00600 EXTERNAL SMPLS
00700 EXTERNAL READIN
00800
00900 TTY←←1
01000 DT←←2
01100 ADCHN←←3
01200 SETUP: CALL [SIXBIT /RESET/]
01300 SETUP1: INIT TTY,1
01400 SIXBIT /TTY/
01500 XWD TOB,TIB
01600 CALL [SIXBIT /EXIT/]; ERROR CONDITION
01700 MOVSI 400000
01800 ANDCAM TIBUF+1 ;MARK INPUT BUFFERS EMPTY.
01900 ANDCAM BUF1+1
02000 ANDCAM BUF2+1
02100 ANDCAM BUF3+1
02200 HRRI TIBUF+1 ;INIT. BUFFER POINTERS.
02300 MOVEM TIB
02400 HRRI TOBUF+1
02500 MOVEM TOB
02600 ;; OUTPUT TTY,1; SEE THE HAPPY SYSTEM
02700 OUTPUT TTY, ;FOR STANDARD SYSTEM(EXPORT)
02800 TRNE FL,RESTART ;ARE WE RESTARTINIG ?
02900 JRST SET4 ;YES.
03000 MOVEI IMS
03100 JSR TXTOUT; A LF/CR *
03200 EXTERNAL FILBRK,DLK,ASTR
03300 INTERNAL DEV
03400 SETZM ASTR
03500 JSA 16,FILBRK
03600 MOVE T2,[SIXBIT/TTY/]
03700 SKIPN DLK
03800 MOVEM T2,DNAM
03900 JRST SET4
04000 ;THE FOLLOW CODE IS UNNECSSARY BECAUSE OF FILBRK
04100 INPUT TTY,0; THE DTA # AND NAME
04200 SETZM DNAM
04300 MOVE 2,[POINT 6,DNAM]
04400 MOVEI T2,6
04500 SET3: ILDB TIB+1
04600 CAIN ":"
04700 JRST SET4
04800 SUBI 40
04900 IDPB 2
05000 SOJG T2,SET3
05100 SET4: INIT DT,1
05200 DNAM:DEV: SIXBIT /DTA/
05300 XWD 0,IBUF ;NO OUPUT ON THIS DEVICE.
05400 JRST AER1
05500 MOVE [XWD 400000,BUF1+1] ;SET UP BUFFER
05600 MOVEM IBUF ;HEADER SO SYSTEM WILL USE OUR BUFFERS.
05700 MOVSI 700
05800 MOVEM SCP ;BYTE SIZE.
05900 ; SETZM DLK+3 ;TO READ FILES OFF DSK
06000 TRZE FL,RESTART
06100 JRST SETIN
06200 ;*** NEXT TWO ARE FOR 'SAVER'
06300 ; MOVEI T,1
06400 ; MOVEM T,RECCT
06500 JRST SETIN
06600 ;THE FOLLOW CODE IS TAKEN CARE OF BY FILBRK
06700 MOVE T1,[POINT 6,DLK]
06800 SETZM DLK
06900 SETZM DLK+1
07000 MOVEI T2,12
07100
00100 RIN: ILDB TIB+1; GET FILE NAME
00200 CAIN 15
00300 JRST SETIN
00400 CAIN "."; AN EXTENSION
00500 JRST SETEX
00600 SUBI 40
00700 IDPB T1
00800 SOJG T2,RIN
00900 JRST SETIN
01000 TIB: 0
01100 POINT 7,0,35
01200 0
01300 TOB: 0
01400 POINT 7,0,35
01500 0
01600 TIBUF: 0
01700 XWD 21,.
01800 BLOCK 22
01900 TOBUF: 0
02000 XWD 21,.
02100 BLOCK 22
02200 ;THIS IS NOW IN FILBRK DLK: BLOCK 4
02300 IBUF: XWD 400000,BUF1+1; MAGIC TO KEEP SYSTEM
02400 SCP: POINT 7,0,35; HAPPY
02500 ICCNT: 0 ;BUFFER CHAR. COUNT.
02600 SETEX: TLZ T1,770000
02700 JRST RIN
02800 SETIN: LOOKUP DT,DLK; GET FILE SETUP
02900 JRST NER; NON-EX FILE
03000 PUSHJ P,RDBUF ;GET FIRST BUFFER
03100 MOVE BUF1+3 ;LINE NO. FIRST ?
03200 TRNE 1
03300 AOS SCP ;YES; ADVANCE SCP PAST IT.
03400 SETZM SNCHR
03500 SETZM FOONLY# ;BARF !!
03600 POPJ P,; DONE
03700 BUF1: 0
03800 XWD 201,BUF2+1
03900 BLOCK 202
04000 BUF2: 0
04100 XWD 201,BUF3+1
04200 BLOCK 202
04300 BUF3: 0
04400 XWD 201,BUF1+1
04500 BLOCK 202
04600
00100 AER1: MOVEI DEV1MS; ERROR ROUTINE FOR NOT AVAILABLE
00200 JSR TXTOUT; DECTAPE
00300 MOVEI T1,4
00400 MOVEI DNAM
00500 PUSHJ P,SIXOUT
00600 MOVEI DEV2MS
00700 JSR TXTOUT
00800 JRST SETUP
00900 NER: MOVEI NAM1MS
01000 JSR TXTOUT
01100 MOVEI T1,6
01200 MOVEI DLK
01300 PUSHJ P,SIXOUT
01400 HLRZ DLK+1
01500 JUMPE NEX1
01600 MOVEI "."
01700 IDPB TOB+1
01800 MOVEI T1,3
01900 MOVEI DLK+1
02000 PUSHJ P,SIXOUT
02100 NEX1: MOVEI NAM2MS
02200 JSR TXTOUT
02300 JRST SETUP
02400 NAM1MS: ASCIZ /
02500 FILE /
02600 NAM2MS: ASCIZ / NOT FOUND
02700 /
02800
02900 DECPNT: PUSHJ P,DECPNN ;SPACE COMES AFTER NUM IS TYPED.
03000 MOVEI A,40
03100 SOSGE TOB+2
03200 OUTPUT TTY,0
03300 IDPB A,TOB+1
03400 POPJ P,
03500
03600
03700 DECPNN: IDIVI A,12 ;PRINT DECIMAL INTEGER FROM A.
03800 HRLM B,(P) ;SAVE LOW ORDER DIGIT.
03900 SKIPE A ;DONE ?
04000 PUSHJ P,DECPNN ;NO. RECUR FOR REST OF DIGITS.
04100 HLRZ A,(P) ;YES. GET HIGH ORDER DIGIT.
04200 ADDI A,"0" ;CONVERT TO ASCII.
04300 SOSGE TOB+2 ;OUTPUT IT.
04400 OUTPUT TTY,0
04500 IDPB A,TOB+1
04600 POPJ P, ;RETURN.
04700
00100 SIXOUT: TLO 440600 ; MAKE BYTE POINTER
00200 LOOPTS: SOJL T1,[POPJ P,]
00300 ILDB T,0
00400 JUMPE T,[POPJ P,]
00500 ADDI T,40
00600 IDPB T,TOB+1
00700 JRST LOOPTS
00800 TXTOUT: 0
00900 TLO 440700; ANOTHER POINTER
01000 LPT1: ILDB T,0
01100 JUMPE T,RETPT
01200 SOSGE TOB+2
01300 OUTPUT TTY,0
01400 IDPB T,TOB+1
01500 JRST LPT1
01600 RETPT: OUTPUT TTY,0
01700 JRST @TXTOUT
01800 DEV1MS: ASCIZ /
01900 DEVICE /
02000 DEV2MS: ASCIZ / NOT AVAILABLE
02100 /
02200 IMS: ASCIZ /
02300 * INPUT ? /
02400
02500 RDBUF: MOVEI [BYTE (7)15,12,52] ;ASCIZ / CR LF */
02600 MOVSI A,'TTY'
02700 CAME A,DNAM ;IS INPUT DEVICE A TTY ?
02800 TLO FL,NOSTAR ;NO. SUPRESS THE *.
02900 TLZN FL,NOSTAR ;PRINT IF NOSTAR NOT ON.
03000 CALLI 3 ;YES. TYPE CR LF *.
03100 ;***** NEXT TWO FOR 'SAVER'
03200 ; USETI DT,@RECCT# ;POSITION INPUT FILE TO RIGHT RECORD.
03300 ; AOS RECCT ;ADD 1 TO RECORD CTR
03400 INPUT DT,0 ;READ NEW INPUT BUFFER.
03500 STATZ DT,20000 ;END OF FILE SEEN ?
03600 JRST SETUP ;YES.
03700 MOVEI 4 ;MAKE SURE 0 WORD TERMINATES IT.
03800 ADD ICCNT ;CHAR. COUNT +4/5 IS WORD COUNT.
03900 MOVEI A,5 ;BECAUSE WE DON'T WANT TO LOSE B.
04000 IDIVM A ;SEE? NO RANDOM REMAINDER !!
04100 ADD A,SCP ;ADD BASE ADDRESS.
04200 IBP A ;BAGBITING SYSTEM.
04300 SETZM (A) ;ZERO IT.
04400 MOVE SCP
04500 MOVEM ISCP# ;SAVE FOR ERROR PRINTOUT.
04600 POPJ P,
04700
00100 SUBTTL ALGOL SCANNER -- 9/8/66 D. POOLE
00200
00300 ;CALL IS PUSHJ P,-----. SCANS NEXT ATOMIC ELEMENT OF
00400 ; INPUT STRING, RETURNS ELEMENT IN ACCUM. 'A' AS FOLLOWS:
00500 ; UNDEFINED IDENTIFIER-- RETURNS 0.
00600 ; DECLARED IDENTIFIER--- 'A' CONTAINS RANDOM GOOD BITS FROM
00700 ; THE SYM. TBL. IN LEFT HALF, PTR. TO RGB WORD IN RT. HALF.
00800 ;RESERVED WORD OR SINGLE-CHARACTER OPERATOR--- 'A' CONTAINS
00900 ; THE RANDOM BITS WORD FROM EITHER THE RESERVED WORD TABLE
01000 ; OR THE CHAR. CONVERT TABLE, RESPECTIVELY.
01100
01200
01300 BUCKNO←←1; SEE DFUNC BEFORE CHANGING !!!!
01400
01500 ACCUM: BLOCK 40 ;GOOD ENOUGH FOR NOW...
01600
01700 SCANNS: TLOA FL,NOSTAR ;SUPRESS PRINTING OF *.
01800
01900 SCANR: TLOA FL,400000 ;ENTRY WHEN EXPECTING OPERATOR OR
02000 ; RESERVED WORD.
02100 SCANV: TLZ FL,400000 ;ENTRY WHEN EXPECTING VARIABLE.
02200
02300 SCAN:
02400 SKIPE A,SNCHR# ;IF SNCHR IS NON-ZERO,
02500 JRST SL1 ; IT IS THE NEXT CHAR. TO SCAN.
02600 SL10: ILDB A,SCP ;GET NEXT CHAR.
02700 SKIPN A,CTBL(A) ;SKIP LEADING BLANKS.
02800 JRST SL10
02900
03000 JUMPL A,SL1A ;IF OPERATOR, WE'RE DONE.
03100 TLNE A,SNUMF ;CHECK FOR PART OF A NUMBER.
03200 JRST SNUM1
03300 MOVE T2,[POINT 6,ACCUM,5] ;PREPARE TO SCAN AN
03400 SETZB T,ACCUM ;IDENTIFIER.
03500 MOVEM T,ACCUM+1
03600 MOVEM A,FOONLY
03700 SL2: IDPB A,T2 ;APPEND CHAR. TO IDENTIFIER.
03800 ILDB A,SCP ;NEXT CHAR.
03900 SKIPLE A,CTBL(A) ;CHECK FOR TERMINATOR.
04000 AOJA T,SL2 ;INCREMENT COUNT AND LOOP.
04100 TLNE A,SSPC2F ;DOES TERMINATING CHAR. REQUIRE
04200 JRST SSPCB ;IMMEDIATE ATTENTION ?
04300 MOVEM A,SNCHR ;NO, SAVE IT FOR NEXT TIME.
04400 ADDI T,1
04500 DPB T,[POINT 6,ACCUM,5] ;PUT COUNT IN FIRST CHAR.
04600 HRRZS T2
04700 SUBI T2,ACCUM
04800 HRRZM T2,ACCWC#
04900
00100 MOVE A,ACCUM ;PREPARE TO SEARCH TABLES.
00200 MOVE C,ACCUM+1
00300 TLZE FL,400000 ;DO WE EXPECT AN OPERATOR ?
00400 JRST SRSCH ;YES; SEARCH RES. WD. TBL. FIRST
00500 SMSCH: MOVE T,A ;SEARCH MAIN SYM. TBL.
00600 IDIVI T,BUCKNO ;DO HASH ON IDENT.
00700 MOVMS T1 ;MAKE SURE IT'S POSITIVE.
00800 MOVEM T1,CBNO# ;SAVE BUCKET NO.
00900 HRRZ B,BUCTBL(T1) ;HEAD OF RIGHT BUCKET
01000 ; IN SYM. TBL.
01100 SL5: CAMN A,1(B) ;COMPARE FIRST WORDS.
01200 JRST SL4
01300 SL6: HRRZ B,(B) ;GET NEXT ELEMENT OF
01400 JRST SL5 ; THE LINKED LIST.
01500 SL4: CAIN B,A-1 ;FIRST WORD WAS EQUAL...
01600 JRST SNO ; WE ARE AT END OF BUCKET.
01700 SKIPN T1,T2
01800 JRST SFOUND ;ONLY 1 WORD; WE'RE DONE.
01900 CAME C,3(B) ;COMPARE SECOND WORDS...
02000 JRST SL6 ;NOPE.
02100 SOJE T1,SFOUND ;ANY MORE WORDS ?
02200 MOVE T3,[XWD B,4]; YES. PREPARE TO CHECK THEM.
02300 SL7: MOVE D,ACCUM-2(T3)
02400 CAME D,@T3
02500 JRST SL6 ;NOT EQUAL.
02600 SOJE T1,SFOUND ;MORE STILL ?
02700 AOJA T3,SL7 ;YES; KEEP CHECKING.
02800
02900 SFOUND: MOVEI A,2(B) ;FOUND HIM; CALC. PTR. TO RGB WORD.
03000 HLL A,(A) ;GET RANDOM GOOD BITS.
03100 HRRZ B,A
03200 SEXIT: CAIG T2,1 ;MORE THAN 2 WORDS OF NAME ?
03300 POPJ P, ;NO.
03400 SETZM ACCUM(T2) ;YES; ZERO OUT ALL THE WORDS OF
03500 SOJA T2,SEXIT ; ACCUM THAT WE USED.
03600
03700 SNO: TLCN FL,400000 ;NOT IN MAIN TBL; HAVE WE ALREADY
03800 JRST SRSCH ; SEARCHED RES. WORD TBL ?
03900 SN1: MOVE A,FOONLY ;GARPBAZ !
04000 TLNE A,FOOBIT
04100 JRST FOOSCH
04200 SCH1: SETZB A,B ;YES. RETURN 'UNDEFINED'.
04300 POPJ P,
04400
04500 SL1: SETZM SNCHR ;RETURN FOR A SPECIAL CHAR.
04600 SL1A: TLNN A,SSPCF+SSPC2F ;DOES IT NEED SPECIAL SERVICE ?
04700 POPJ P, ;NO.
04800 PUSHJ P,(A) ;YES. DISPATCH ON IT.
04900 JRST SL10 ;CONTINUE SCANNING.
05000
00100 FOOSCH: LDB B,[POINT 6,ACCUM,17]
00200 TRNE FL,SFOOBT ;ARE WE DEFINING A FUNCTION ?
00300 JRST SCH1 ;YES. NO FOO-SYMBOLS ALLOWED.
00400 CAIG B,31 ;IS IT A DIGIT?
00500 CAIGE B,20
00600 JRST SCH1 ;NO.
00700 SUBI B,20 ; TO VALUE.
00800 LDB C,[POINT 6,ACCUM,23]
00900 JUMPE C,FSCH1
01000 LDB D,[POINT 6,ACCUM,29]
01100 JUMPN D,SCH1
01200 IMULI B,12 ;MUL. TENS DIGIT BY 10.
01300 CAIG C,31
01400 CAIGE C,20
01500 JRST SCH1
01600 ADDI B,-20(C) ;ADD IN ONE'S DIGIT.
01700 FSCH1: DPB B,[POINT 17,A,35] ;PUT NUMBER IN A.
01800 POPJ P, ;RETURN FROM SCAN.
01900
02000
02100 S.VT: ;HERE ON VERTICAL TAB.
02200 S.FF: ;FORM FEED.
02300 S.LF: ;LINE FEED
02400 SENDL: TLZ FL,ERRFLG ;END OF LINE. CLEAR ERROR FLAG.
02500 MOVEI A,1
02600 ADD A,SCP ;GET PTR TO NEXT WORD.
02700 SKIPN T,(A)
02800 JRST S.EOB ;ZERO WORD MEANS END OF BUFFER.
02900 TRNN T,1 ;IS IT A LINE NO. ?
03000 POPJ P, ;NO; CONTINUE SCANNING.
03100 TLZ A,770000 ;YES; ADVANCE PTR. PAST IT.
03200 MOVEM A,SCP
03300 POPJ P,
03400 S.EOB: PUSHJ P,RDBUF ;REFILL BUFFER.
03500 JRST SENDL
03600
03700 SSPCB: HALT
03800
03900 SSPCC: HALT
04000
04100 S.LT: ILDB A,SCP ;'<' SEEN; SKIP TO END OF LINE.
04200 CAIE A,12 ;A LINE FEED ?
04300 JRST S.LT ;NO.
04400 JRST SENDL
04500
00100 SNUM1: MOVEI C,0 ;NUMBER SCANNER.
00200 CAMN A,DOTV ;FIRST THING A DECIMAL PT.?
00300 JRST SNUM6 ;YES
00400 MOVNI T,100 ;NO DEC PT. YET.
00500 SNUM2: IMULI C,12
00600 ADDI C,-20(A) ;CONVERT NEW DIGIT TO VALUE AND ADD IN
00700 AOSA T ;INCREMENT DEC. PLACE COUNT.
00800 SNUM6: MOVEI T,0 ;START COUNTING DEC. PLACES.
00900 ILDB A,SCP ;NEXT CHAR.
01000 SKIPG A,CTBL(A) ;GET MAGIC BITS.
01100 JRST SNUM7 ;IT'S A DELIMITER.
01200 TLNE A,SDFLG ;IS IT A DIGIT ?
01300 JRST SNUM2 ;YES.
01400 CAMN A,DOTV ;A DEC. PT. ?
01500 JRST SNUM6 ;YES.
01600 JRST SNUMX1
01700 SNUM7: TLNE A,SSPC2F ;DOES DELIM. REQUIRE INSTANT SERVICE ?
01800 JRST SSPCC ;YES.
01900 MOVEM A,SNCHR ;SAVE FOR NEXT TIME.
02000 ; JUMPLE T,SNFX ;IF NO DEC. PT. SEEN, IT'S FIXED PT.
02100 SFLTIT: IDIVI C,400000 ;FLOAT IT.
02200 SKIPE C
02300 TLC C,254000
02400 TLC D,233000
02500 FAD C,D
02600 SKIPLE T
02700 FDVR C,[10.0] ;DIVIDE BY 10 ENOUGH TO GET
02800 SOJG T,.-1 ;DEC. PT. IN RIGHT PLACE.
02900 SKIPA T,[XWD FLTFLG,0] ;GET FLOATING PT. FLAG.
03000 SNFX: MOVSI T,FIXFLG
03100 HLLZ A,T ;COPY FLAG TO A.
03200 TRNN FL,SFOOBT
03300 TLZE FL,SNUMF1
03400 POPJ P,
03500
00100 ;; NOW SEARCH NUMBER TABLE FOR THE NUMBER.
00200
00300 TDOA A,NUMBUC ;NUMBUC TO RT. HALF.
00400 SNUM4: HRR A,-1(A) ;GET NEXT LINK.
00500 CAME C,(A) ;IS IT EQUAL ?
00600 JRST .-2 ;NO.
00700 TRNN A,777760 ;ARE WE AT END OF TABLE ?
00800 JRST SNUMNO ;YES.
00900 TDNN T,-1(A) ;NO. DO TYPES MATCH ?
01000 JRST SNUM4 ;NO.
01100 POPJ P, ;YUP. WE'VE FOUND IT.
01200
01300 SNUMNO: TRNE FL,CSBRBT ;ARE WE INSIDE A FUNCTION DEFINITION ?
01400 JRST SNUMX ;YES.
01500 AOS B,JOBFF ;INSERT NEW NUMBER IN TABLE.
01600 HRR A,B
01700 EXCH B,NUMBUC ;UPDATE NUMBUC.
01800 HRRM B,-1(A) ;PUT IN NEW LINK.
01900 HLLM A,-1(A) ;PUT IN TYPE FLAG.
02000 MOVEM C,(A) ;ALSO VALUE.
02100 AOS T,JOBFF ;BUMP POINTER PAST VALUE.
02200 HRLM T,JOBSA
02300 POPJ P,
02400
02500 SNUMX: IOR T,VLOC ;WE WILL PUT NO. IN VARIABLES AREA.
02600 PUSH P,T ;SAVE PTR. TO LOC.
02700 MOVE A,C ;VALUE OF NO. TO A.
02800 MOVEI B,0 ;NO RELOCATION.
02900 PUSHJ P,EMVCDI ;EMIT TO VARIABLES BUFFER.
03000 JRST POPAJ ;SEE EMINST.
03100
00100 ; RESERVED WORD TABLE SEARCHER.
00200
00300
00400 SRSCH: LDB B,[POINT 6,ACCUM,5] ;GET CHAR. COUNT.
00500 CAIL B,3 ;NO 1-CHAR. RES. WDS.
00600 CAILE B,13 ;ALSO NONE OF > 9 CHARS.
00700 JRST SRNO
00800 MOVE B,SRTBL1-2(B) ;GET RIGHT SECTION OF TBL.
00900 CAME A,(B) ;COMPARE FIRST WORD.
01000 SRS1: AOBJN B,.-1
01100 JUMPGE B,SRNO ;ARE WE AT END OF SETCTION ?
01200 CAME C,LRTBL(B) ;NO; COMPARE SECOND WORD.
01300 JRST SRS1
01400 MOVE A,2*LRTBL(B) ;THIS IS IT; GET GOOD BITS.
01500 TLNE A,SSPCF ;DOES IT NEED OUR ATTENTION ?
01600 JRST (A) ;YES.
01700 JRST SEXIT ;NO.
01800
01900 SRNO: TLCN FL,400000 ;NOT A RES. WORD; HAVE WE ALREADY
02000 JRST SMSCH ;SEARCHED MAIN SYM. TBL. ?
02100 JRST SN1 ; YES; RETURN.
02200
02300 .COMME: MOVE A,SNCHR ;A COMMENT; SKIP TO NEXT ';'
02400 SETZM SNCHR
02500 .COMM1: CAMN A,SEMICV
02600 JRST SCAN
02700 TLNE A,SSPCF+SSPC2F ;SPECIAL TREATMENT ?
02800 PUSHJ P,(A) ;YES.
02900 ILDB A,SCP
03000 MOVE A,CTBL(A)
03100 JRST .COMM1
03200
03300
03400 BUCTBL: REPEAT BUCKNO,<EXP TEMPSY> ;TABLE OF HEADS OF THE
03500 ;HASH-CODED BUCKETS IN SYM. TABLE.
03600
03700 NUMBUC: EXP C ;HEAD OF NUMBER TABLE
03800
00100 ;THE CHARACTER CONVERSION TABLE -- GOOD BITS FOR EVERYONE !
00200 ; GET YOURS WHILE THEY LAST !
00300
00400 OPDEF ILG [XWD DF+SSPCF,SILCH]
00500
00600 CTBL: XWD DF+SSPCF,SENDL
00700 REPEAT 10,<ILG>
00800 0 ; HORIZONTAL TAB.
00900 XWD DF+SSPCF,S.LF ;LINE FEED
01000 XWD DF+SSPCF,S.VT ; VERTICAL TAB
01100 XWD DF+SSPCF,S.FF ;FORM FEED
01200 0 ;CARRIAGE RETURN.
01300 REPEAT 14,<ILG>
01400 XWD DF+SSPCF,SENDL ;↑Z.
01500 REPEAT 5,<ILG>
01600 0 ;SPACE
01700 REPEAT 7,<ILG>
01800 LPARV: XWD DF,1
01900 RPARV: XWD DF,2
02000 XWD DF+MULBIT,MULOP ; *
02100 PLSV: XWD DF+ADDBIT,ADDOP ; +
02200 COMMAV: XWD DF,COMMOP ; ,
02300 MINV: XWD DF+ADDBIT,SUBOP ; -
02400 DOTV: XWD SNUMF,"." ; .
02500 XWD DF+MULBIT,DIVOP ; /
02600 CTNUM: REPEAT 12,<XWD SDFLG+SNUMF,20+.-CTNUM> ; THE DIGITS.
02700
02800 COLONV: XWD DF,3 ; :
02900 SEMICV: XWD DF,4 ; ;
03000 XWD DF+SSPCF,S.LT ;<
03010 XWD DF,ASNOP ; ← AND = BOTH WORK NOW. 5/74
03100 ;; XWD DF+RELBIT,EOP ; =
03200 XWD DF+RELBIT,GOP ; >
03300 REPEAT 2,<ILG>
03400 CTLTR: REPEAT =5,<XWD 0,41+.-CTLTR> ;THE LETTERS.
03500 41+.-CTLTR ;F
03600 REPEAT =9,<41+.-CTLTR>
03700 XWD FOOBIT,41+.-CTLTR+400000 ;P
03800 REPEAT 4,<41+.-CTLTR>
03900 XWD FOOBIT,41+.-CTLTR
04000 REPEAT 5,<41+.-CTLTR>
04100
04200 LFTBRK: XWD DF,5 ; [
04300 ILG
04400 RGTBRK: XWD DF,6
04500 UARV: XWD DF,EXPOP ; ↑
04600 LARV: XWD DF,ASNOP ; ←
04700 REPEAT 35,<ILG>
04800 ALTV: XWD DF,. ;ALT MODE.
04900 REPEAT 2,<ILG>
05000 ; END OF CONVERT TABLE.
05100
00100 DEFINE PUT1 (N,Y)
00200 < FOR X IN (Y)
00300 <Q←<SIXBIT /X/>
00400 N*10000000000+(7777777777&(Q/100))
00500 >>
00600
00700 DEFINE PUT2 (Y)
00800 <FOR X IN (Y)
00900 <SIXBIT /X/
01000 >>
01100
01200 RTBL: ;THE RESERVED WORD TABLE.
01300 RT3C: PUT1 (3,END) ;THE 3-LETTER SECTION.
01400 RT4C: PUT1(4,<PLAY>)
01500 RT5C: PUT1(5,<ARRAY>)
01600 RT6C: PUT1 (6,FINIS) ;THE 6-LETTER SECTION.
01700 RT7C: PUT1 (7,<COMME,COMPI>)
01800 RT8C: PUT1 (10,<VARIA,FUNCT,EXTER>) ;VARIABLE
01900 RT10C: PUT1 (12,INSTR) ;
02000
02100 LRTBL←←.-RTBL
02200
02300 RTBL2: 0 ;END
02400 0 ;PLAY.
02500 0
02600 PUT2 (H)
02700 PUT2 (<NT,LE>) ;COMMENT
02800 PUT2 (<BLE,ION,NAL>)
02900 PUT2 (UMENT) ;INSTRUMENT
03000
03100 RF←←DF+RFLG
03200
03300 RTBL3:
03400 ENDV: XWD RF,.
03500 PLAYV: XWD RF,.
03600 ARRV: XWD RF+DECLBIT,DARR
03700 FINV: XWD RF,.
03800 COMV: XWD SSPCF,.COMME
03900 COMPV: XWD RF,.
04000 VARV: XWD RF+DECLBIT,DVRBL
04100 FUNV: XWD RF+DECLBIT,DFUNC ;FUNCTION
04200 EXTV: XWD RF+DECLBIT,EXTD
04300 INSV: XWD RF+DECLBIT,CINS
04400
04500 SRTBL1: 0 ;2
04600 XWD -1,RT3C
04700 XWD -1,RT4C
04800 XWD -1,RT5C
04900 XWD -1,RT6C
05000 XWD -2,RT7C
05100 XWD -3,RT8C
05200 0
05300 XWD -1,RT10C
05400 0
05500 SRSFOO: JUMP 2*LRTBL(B)
05600
00100 ;; MORE BITS AND PARAMETERS.
00200 RELBIT←←0
00300 ;SIZES OF VARIOUS STACKS AND TABLES:
00400 LOBUFS←←200
00500 LUOTBL←←62
00600 LPLIST←←100
00700 LOSTK←←40
00800 LPA←←62
00900 LRQ←←=75 ;LENGTH OF RUN QUEUE.
01000
01100 ;SPECIAL AC DEFINITIONS :
01200 RA←16 ;AC FOR JSA LINKAGE AT RUNTIME.
01300
01400
01500 DEFINE MAKOP1 (X)
01600 <FOR @$ A IN (X)
01700 <A$OP: HALT
01800 >>
01900
02000 MAKOP1 <PW,COMM,L,E,G,EXP,ENDS,WHLS>
02100
02200 ;; TEMPORARY AND DEBUGGING ROUTINES:
02300 GO: MOVE P,[IOWD LPLIST,PLIST]
02400 AOSE ONCEFG ;IS THIS FIRST TIME THROUGH ?
02500 JRST GOA ;NO. LEAVE JOBFF AT CURRENT PLACE.
02600 HRLZ 116 ;YES. GET BOTTOM OF SYM. TAB. FROM JOBSYM.
02700 SUB 116 ;ADD LENGTH OF SYM. TAB.
02800 HRLM JOBFF
02900 GOA: HRR JOBFF
03000 HRLM JOBSA
03100 MOVEI FL,0
03200 PUSHJ P,SETUP
03300 GOB: MOVE P,[IOWD LPLIST,PLIST]
03400 MOVE [JSR UUOSER] ;SET UP FOR ERROR UUO.
03500 MOVEM 41
03600 MOVE JOBREL
03700 MOVEM JOBSYM
03800 JRST SCHOWN
03900
04000 ONCEFG: -1
04100
04200 DEFINE ERROR (M)
04300 <XWD 1000,[ASCIZ /M/] >
04400
04500 UDIERR: ERROR (UNDEFINED IDENTIFIER)
04600
04700 SILCH: ERROR (ILLEGAL CHARACTER)
04800 SNUMX1: ERROR(ILLEGAL CHAR. IN NUMBER)
04900 FNDWV: HALT
05000 ;USEFUL F4 FUNCTIONS TO HAVE AROUND....
05100 EXTERNAL SIN,COS,EXP,ALOG,SQRT
05200
00100 TEMPSY: EXP TMPS1Z
00200 PUT1 5,OSCIL
00300 XWD UGBIT,.+2
00400 0
00500 JSP RA,@OSCIL ;POINTER DID NOT RESET WITH '1,5,0,1' IN NEXT!!!!
00600 BYTE (6)4,2,2,1,4,0,1;***** JULY 3,71 THIS ENDED '1,5,0,1' ****
00700 TMPS1Z: TMPS1
00800 PUT1 6,ZOSCI
00900 XWD UGBIT,.+3
01000 PUT2 (L)
01100 0
01200 JSP RA,@ZOSCIL
01300 BYTE (6)4,2,2,1,5,0,1
01400 ;CHANGE LAST OF ABOVE TO .. 4,0,1 TO MAKE ZOSCIL NOT LIKE COSCIL
01500 TMPS1: EXP TIMESC+1
01600 PUT1 6,TIMES
01700 XWD VRBLBT,TIMESC
01800 PUT2 C
01900 TIMESC: 1.0
02000 EXP SRATE+1
02100 PUT1 5,SRATE
02200 XWD VRBLBT,SRATE
02300 SRATE: 10000.0
02400 EXP NCHNS+1
02500 PUT1 5,NCHNS
02600 XWD VRBLBT,NCHNS
02700 NCHNS: 1
02800 EXP LSBUF+1
02900 PUT1 5,LSBUF
03000 XWD VRBLBT,LSBUF
03100 LSBUF: 1000
03200 EXP TMPS2
03300 PUT1 3,OUT
03400 XWD UGBIT,.+2
03500 0
03600 JSA RA,@OUT
03700 BYTE (6)1,2,0,0
03800 TMPS2: EXP TMPS3
03900 PUT1 4,OUT2
04000 XWD UGBIT,.+2
04100 0
04200 JSA RA,@OUT2
04300 BYTE (6)3,2,2,2,0,0
04400 TMPS3: TMPS3A
04500 PUT1 5,SPEED
04600 XWD VRBLBT,SPEED
04700 SPEED: 1
04800 TMPS3A: TMPS11
04900 PUT1 6,ZINTR
05000 XWD UGBIT,.+3
05100 PUT2 P
05200 JSA RA,IINTRP
05300 JSP RA,@ZINTRP
05400 BYTE (6)5,2,2,5,1,4,0,T
05500
05600 TMPS11: TMNOSA
05700 PUT1 6,VFMUL
05800 XWD UGBIT,.+3
05900 PUT2 T
06000 0
06100 JSP RA,@VFMULT
06200 BYTE (6)3,2,2,1,0,T
06300 ; OSCIL IS NOW THE NOSCIL...JMG 7/14/73
06400
06500 ; SOMEDAY, IF IT IS EVER USED, SOMEONE COULD CHANGE
06600 ; THE NAME OF NOSCA TO OSCA, ETC.
06700 ;TMPS12: TMNOSA
06800 ; PUT1 6,NOSCI
06900 ; XWD UGBIT,.+3
07000 ; PUT2 L
07100 ; 0
07200 ; JSP RA,@NOSCIL
07300 ; BYTE (6)4,2,2,1,4,0,1
07400
07500 TMNOSA: TMPS13
07600 PUT1 5,NOSCA
07700 XWD UGBIT,.+2
07800 JSA RA,INOSCA
07900 JSP RA,@NOSCA
08000 BYTE (6)5,2,2,2,1,5,0,T
08100
08200 ;TMPS13: TMPS14
08300 ; PUT1 10,DISKF
08400 ; XWD VRBLBT,DISKFL
08500 ; PUT2 LAG
08600 ;DISKFL: 0
08700
08800 TMPS13: TMPS24
08900 PUT1 5,INTRP
09000 XWD UGBIT,.+2
09100 JSA RA,IINTRP
09200 JSP RA,@INTRP
09300 BYTE (6)5,2,2,5,1,4,0,T
09400 TMPS24: TMPS14
09500 PUT1 4,READ
09600 XWD UGBIT,.+2
09700 JSP RA,READI
09800 JSP RA,@READ
09900 BYTE (6)6,2,2,1,2,5,5,0,T
10000 TMPS14: TMPS15
10100 PUT1 4,REVX
10200 XWD UGBIT,.+2
10300 JSP RA,REVXI
10400 JSP RA,@REVX
10500 BYTE (6)20,2,2,2,2,2,2,2,2,2,4,4,4,4,4,1,4,0,T
10600
10700 TMPS15: .+3
10800 PUT1 4,OUTA
10900 XWD VRBLBT,OUTA
11000 .+3
11100 PUT1 4,OUTB
11200 XWD VRBLBT,OUTB
11300 .+3
11400 PUT1 4,OUTC
11500 XWD VRBLBT,OUTC
11600 .+4 ;DOPLAY←1=WILL PLAY WHEN WRITING SMPLS ON DSK
11700 PUT1 6,DOPLA
11800 XWD VRBLBT,DOPLAY#
11900 PUT2 Y
12000 .+3
12100 PUT1 4,OUTD
12200 XWD VRBLBT,OUTD
12300 .+4 ;RCDFLG←1 PUTS SAMPLES ON DSK UNDER 'MUSAA','MUSAB',ETC.
12400 PUT1 6,RCDFL
12500 XWD VRBLBT,RCDFLG#
12600 PUT2 G
12700 ; .+4
12800 ; PUT1 6,DSKFL
12900 ; XWD VRBLBT,DSKFLG#
13000 ; PUT2 G
13100 .+4
13200 PUT1 6,BIGBI
13300 XWD VRBLBT,BIGBIT#
13400 PUT2 T
13500 .+6
13600 PUT1 5,VALUE
13700 XWD UGBIT,.+2
13800 0
13900 JSP RA,@VALUE
14000 BYTE (6)1,2,0,T
14100 .+5
14200 PUT1 4,RAND
14300 XWD FUNBIT,.+1
14400 PUSHJ P,RAND
14500 BYTE (6)0,T
14600 FRSTB+1
14700 PUT1 =9,FIRST
14800 XWD VRBLBT,FRSTB
14900 PUT2 BAND
15000 FRSTB: 0
15100 .+5
15200 PUT1 5,PRINT
15300 XWD FUNBIT,.+1
15400 JSA RA,FOOPRT
15500 BYTE (6)1,2,0,0
15600 .+3
15700 PUT1 3,RDA
15800 XWD RVBT∨VRBLBT,RDA
15900 .+3
16000 PUT1 3,RDB
16100 XWD RVBT∨VRBLBT,RDB
16200 .+3
16300 PUT1 3,RDC
16400 XWD RVBT∨VRBLBT,RDC
16500 .+3
16600 PUT1 3,RDD
16700 XWD RVBT∨VRBLBT,RDD
16800
00100 TMPSA: EXP TMPS4 ;LINEN.
00200 PUT1 5,LINEN
00300 XWD UGBIT,.+2
00400 JSA RA,LINEN1
00500 JSP RA,@LINEN
00600 ; BYTE (6)13,4,4,4,2,2,2,2,1,4,4,4,0,1
00700 BYTE (6)13,4,4,4,2,2,2,2,1,2,4,4,0,1
00800 ;NOW YOU MUST RESET PTR IN LINEN
00900 TMPS4: EXP TMPS4A
01000 ;TMPS4: EXP TMPS5
01100 PUT1 5,EXPEN
01200 XWD UGBIT,.+2
01300 0
01400 JSP RA,@EXPEN
01500 BYTE (6)4,2,2,1,4,0,1
01600
01700 TMPS4A: EXP TMPS5
01800 PUT1 6,ZEXPE
01900 XWD UGBIT,.+3
02000 PUT2 N
02100 0
02200 JSP RA,@ZEXPEN
02300 BYTE (6)4,2,2,1,4,0,1
02400
02500 TMPS5: EXP TMPS6
02600 PUT1 (4,REV1) ;REV1
02700 XWD UGBIT,.+2
02800 JSP RA,REVI
02900 JSP RA,@REV1
03000 BYTE (6)6,2,2,2,1,5,4,0,1
03100 TMPS6: EXP TMPS7
03200 PUT1 4,REV2
03300 XWD UGBIT,.+2
03400 JSP RA,REVI
03500 JSP RA,@REV2
03600 BYTE (6)6,2,2,2,1,5,4,0,1
03700
03800 TMPS7: EXP TMPS8
03900 PUT1 (7,REVIN) ;REVINIT.
04000 XWD VRBLBT,REVINI
04100 PUT2 IT
04200 REVINI: 0
04300
04400 TMPS8: EXP TMPS9
04500 PUT1 (5,RANDH)
04600 XWD UGBIT,.+2
04700 JSP RA,IRANDH
04800 JSP RA,@RANDH
04900 BYTE (6)4,2,2,4,4,0,1
05000 TMPS9: EXP TMPS10
05100 PUT1 (5,RANDI)
05200 XWD UGBIT,.+2
05300 JSP RA,IRANDI
05400 JSP RA,@RANDI
05500 BYTE (6)5,2,2,4,4,4,0,1
05600 TMPS10: EXP A-1
05700 PUT1 6,COSCI
05800 XWD UGBIT,.+3
05900 PUT2 L
06000 0
06100 ; JSP RA,@NOSCIL
06200 JSP RA,@OSCIL
06300 BYTE (6)4,2,2,1,5,0,1
06400
00100 ;; HERE ARE SOME WONDERFUL UNIT GENERATORS.
00200
00300 ; THIS IS THE OLD OSCIL WHICH DOESN'T LIKE NEG. INCS.
00400 ;OSCIL: MOVE INSXR,3(RA)
00500 ; FIX INSXR,233000
00600 ; TRZE INSXR,777000
00700 ; JSP T1,OSCIL1
00800 ; MOVE T,@2(RA)
00900 ; FMPR T,@(RA)
01000 ; SKIPGE T1,@1(RA) ;OSCIL DOESN'T WANT NEG. INC.
01100 ; ERROR (NEGATIVE INC. TO OSCIL)
01200 ; FADM T1,3(RA)
01300 ; JRST 4(RA)
01400 NOSCA: ADDI RA,1
01500 ;NOSCIL: MOVE INSXR,3(RA)
01600 OSCIL: MOVE INSXR,3(RA)
01700 FAD INSXR,[0.5]
01800 HRLZI T1,233000
01900 UFA T1,INSXR
02000 ; FIX INSXR,233000
02100 ; THE ABOVE 2 INST'S REPLACE THE FIX FOR INDEXING
02200 TRZE INSXR,777000
02300 JSP T1,OSCIL1
02400 MOVE T,@2(RA)
02500 FMPR T,@(RA)
02600 MOVE T1,@1(RA)
02700 FADM T1,3(RA)
02800 JRST 4(RA)
02900 OSCIL1: MOVSI (-512.0) ;WRAP AROUND THE POINTER.
03000 JUMPGE INSXR,.+2
03100 MOVNS 0 ;IF NEG. INC., WRAP AROUND OTHER WAY.
03200 FADM 3(RA)
03300 HRLI INSXR,0 ;TO ALLOW ZOSCIL=NOSCIL
03400 JRST (T1)
03500
03600 OUT: 0
03700 MOVE @(RA) ;PICK UP INPUT.
03800 FADM OUTA ;ACCUMULATE INTO OUTPUT ARRAY.
03900 POPJ P, ;RETURN FROM INSTRUMENT.
04000
04100 OUT2: 0
04200 MOVE @(RA)
04300 MOVE 1,0
04400 FMP @1(RA)
04500 FADM OUTA ;
04600 FMP 1,@2(RA)
04700 FADM 1,OUTB
04800 POPJ P,
04900
05000 EXPEN: MOVE INSXR,@1(RA) ;GET INCREMENT.
05100 FADB INSXR,3(RA) ;INCREMENT POINTER.
05200 ; FIX INSXR,233000
05300 HRLZI T1,233000
05400 UFA T1,INSXR
05500 ; CAIL INSXR,777 ;IF GREATER THAN 512, STICK
05600 TRZE INSXR,777000
05700 EXPEN2: MOVEI INSXR,777 ;AT LAST ELEMENT OF ARRAY.
05800 MOVE T,@2(RA) ;GET ARRAY ELEMENT.
05900 FMPR T,@(RA) ;MULTIPLY BY AMPLITUDE.
06000 JRST 4(RA) ;RETURN.
06100 VFM2: FSBR INSXR,[512.0] ;YOU MUST NOW SET PTR FOR VFMULT!
06200 MOVEM INSXR,@VFMULT
06300
06400 VFMULT: MOVE INSXR,@1(RA) ;GET POINTER INPUT.
06500 CAML INSXR,[512.0]
06600 JRST VFM2
06700 ; FIX INSXR,233000
06800 HRLZI T1,233000
06900 UFA T1,INSXR
07000 MOVE T,@2(RA) ;GET INDICATED ELEMENT OF ARRAY.
07100 FMPR T,@(RA) ;MULT. BY AMPLITUDE.
07200 JRST 3(RA)
07300
07400 INOSCA: 0
07500 MOVE T,(RA)
07600 MOVE T1,@-6(T)
07700 MOVEM T1,-2(T)
07800 JRA RA,1(RA)
07900 INTRP: ADDI RA,1
08000 MOVE INSXR,3(RA)
08100 ; FIX INSXR,233000
08200 HRLZI T1,233000
08300 UFA T1,INSXR
08400 TRZE INSXR,777000
08500 JSP T1,OSCIL1
08600 MOVE T,@2(RA)
08700 FMPR T,@(RA)
08800 FADR T,@-1(RA)
08900 MOVE T1,1(RA)
09000 FADM T1,3(RA)
09100 JRST 4(RA)
09200
09300 IINTRP: 0
09400 MOVE T,(RA)
09500 MOVE T1,@-5(T)
09600 FSBR T1,@-6(T)
09700 MOVEM T1,@-5(T)
09800 MOVSI T1,(512.0)
09900 FDVR T1,SRATE
10000 FDVR T1,PBASE+2
10100 MOVEM T1,-4(T)
10200 JRA RA,1(RA)
10300
10400 ZEXPEN: SKIPGE INSXR,3(RA) ;ZEXPEN WORKS LIKE ZOSCIL AND EXPEN!
10500 JRST[ ERROR (NEGATIVE INC. TO ZEXPEN)
10600 JSP T1,OSCIL1 ;DO WRAPAROUND ANYWAY
10700 JRST .+1] ;LET THE LOSER CONTINUE
10800 ; IT TAKES THESE 4 INST'S TO DO A GOOD FIX FOR FURTHER USE
10900 ; FIX INSXR,233000
11000 HRLZI T1,233000
11100 UFA T1,INSXR
11200 JUMPE INSXR,.+2
11300 TLC INSXR,233000
11400 CAIL INSXR,777 ;IF GREATER THAN 511, STICK
11500 JRST EXPEN2 ;AT LAST ELEMENT (WE WON'T NEED TO INTERPOLATE)
11600 MOVE T,@2(RA) ;PICK UP FIRST ELEMENT
11700 move insxr ;SAVE INDEX
11800 move t1,t ;COPY FIRST ELEMENT
11900 addi insxr,1 ;NO, INCREMENT INDEX
12000 fsbr t1,@2(ra) ;GET DWFFERENCE IN VALUE I
12100 fsc 233 ;(FLOAT THE INDEX)
12200 fsb 3(ra) ;GET DIFFERENCE IN INDEX INTO 0
12300 fmpr t1,0 ;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
12400 fadr t,t1 ;IS ADDED TO THE FIRST ELEMENT
12500 FMPR T,@(RA) ;SCALED BY AMPLITUDE
12600 MOVE T1,@1(RA) ;UPDATE SUM OF INCREMENTS
12700 FADM T1,3(RA)
12800 JRST 4(RA)
12900
13000 ZINTRP: ADDI RA,1 ;AN INTERPOLATING INTRP!
13100 MOVE INSXR,3(RA)
13200 ; FIX INSXR,233000
13300 HRLZI T1,233000
13400 UFA T1,INSXR
13500 JUMPE INSXR,.+2
13600 TLC INSXR,233000
13700 TRZE INSXR,777000 ;DID WE RUN OVER?
13800 JSP T1,OSCIL1 ;YES, DO WRAPAROUND (BUT IT REALLY SHOULDN'T!)
13900 MOVE T,@2(RA) ;PICK UP FIRST ELEMENT
14000 move insxr ;SAVE INDEX
14100 move t1,t ;COPY FIRST ELEMENT
14200 cain insxr,777 ;ARE WE AT THE LAST ELEMENT
14300 tdza insxr,insxr ;YES, SET INDEX TO ZERO AND SKIP
14400 addi insxr,1 ;NO, INCREMENT INDEX
14500 fsbr t1,@2(ra) ;GET DIFFERENCE IN VALUE I
14600 fsc 233 ;(FLOAT THE INDEX)
14700 fsb 3(ra) ;GET DIFFERENCE IN INDEX INTO 0
14800 fmpr t1,0 ;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
14900 fadr t,t1 ;IS ADDED TO THE FIRST ELEMENT
15000 MOVE @(RA) ;GET SECOND VALUE
15100 FSBR @-1(RA) ;SUBTRACT THE FIRST
15200 FMPR T,0 ;MULIPLY BY DIFFENCE BETWEEN TWO VALUES
15300 FADR T,@-1(RA) ;AND ADD TO THE FIRST VALUE
15400 MOVE T1,1(RA) ;UPDATE SUM OF INCREMENTS
15500 FADM T1,3(RA)
15600 JRST 4(RA)
15700
15800 READ: AOS INSXR,4(RA)
15900 CAML INSXR,5(RA)
16000 JRST READ1
16100 MOVEI T,0
16200 LCS2: MOVE @2(RA)
16300 MOVEM RDA(T)
16400 ADDI T,1
16500 CAML T,3(RA)
16600 JRST 7(RA)
16700 AOS INSXR,4(RA)
16800 JRST LCS2
16900
17000 READ1: MOVE 2(RA)
17100 MOVEM LCS+3
17200 SUBI 1
17300 HRRZM LCS+4
17400 LCS: JSA 16,READIN
17500 0
17600 0
17700 0
17800 0
17900 [-1]
18000 SETZB INSXR,4(RA)
18100 JRST READ+3
18200
18300 READI: MOVE T,(RA)
18400 MOVE T2,@-4(T)
18500 FIX T2,233000
18600 MOVEM T2,-4(T)
18700 MOVE T2,-7(T)
18800 MOVEM T2,LCS1+1
18900 MOVE T2,-6(T)
19000 MOVEM T2,LCS1+2
19100 MOVE T1,-5(T)
19200 MOVE T2, -1(T1)
19300 MOVEM T2,-2(T)
19400 SETOM -3(T)
19500 MOVEM T1,LCS1+3
19600 LCS1: JSA RA,READIN
19700 0
19800 0
19900 0
20000 T2
20100 [0]
20200 JRST 1(RA)
20300
20400 ZOSCIL: MOVE INSXR,3(RA) ;ZOSCIL WORKS LIKE COSCIL AND NOSCIL!
20500 ; FIX INSXR,233000
20600 HRLZI T1,233000
20700 UFA T1,INSXR
20800 JUMPE INSXR,.+2
20900 TLC INSXR,233000
21000 TRZE INSXR,777000
21100 JSP T1,OSCIL1
21200 MOVE T,@2(RA)
21300 move insxr
21400 move t1,t
21500 cain insxr,777
21600 tdza insxr,insxr
21700 addi insxr,1
21800 fsbr t1,@2(ra)
21900 fsc 233
22000 fsb 3(ra)
22100 fmpr t1,0
22200 fadr t,t1
22300 FMPR T,@(RA)
22400 MOVE T1,@1(RA)
22500 FADM T1,3(RA)
22600 JRST 4(RA)
22700
00100 ;; REVERBERATION UNIT GENERATORS.
00200 ; REV1 IS THE SIMPLE FED-BACK DELAY LOOP, OR 'COMB FILTER'.
00300
00400 REV1: AOS INSXR,4(RA) ;INCREMENT OUTPUT PTR.
00500 CAML INSXR,5(RA) ;IS IT TIME TO WRAP AROUND ?
00600 SETZB INSXR,4(RA) ;YES.
00700 MOVE 1,@3(RA) ;GET OUTPUT OF DELAY LINE.
00800 MOVE 2,1 ;LEAVE IN 1 AS FINAL OUTPUT.
00900 FMPR 2,@2(RA) ;MULTIPLY BY FEEDBACK GAIN.
01000 ;REVA: MOVE @1(RA) ;GET DELAY TIME, T.
01100 ; FIX 233000
01200 ; ADD INSXR,0 ;MOVE PTR. AROUND TO INPUT END.
01300 ; CAML INSXR,5(RA) ;PROBABLY HAVE TO WRAP AROUND..
01400 ; SUB INSXR,5(RA) ;YUP. SUBTRACT LENGTH OF DELAY ARRAY.
01500 ; THE ABOVE 5 INSTRUCTIONS ALLOW A DYNAMICALLY CONTROLLED
01600 ; DELAY TIME IN REVERB. TO INSTITUTE, CHANGE THE LOC. OF
01700 ; 'REVA:' BACK TO ABOVE AND DE-COMMENT. THE PRESENT REVERB
01800 ; ASSUMES THAT THE ARRAY LENGTH IS THE DELAY, SO THE ARGU-
01900 ; MENT IN THE UG IS IGNORED... JMG 7/14/73
02000 REVA: FADR 2,@(RA) ;ADD IN THE INPUT SAMPLE.
02100 JFCL 1,[SETZB 2,1 ;FLOAT. UNDER FLOW
02200 SETOM FXUFLG#
02300 JRST .+1] ;THESE WERE ON JC,MUS. WHY???
02400 MOVEM 2,@3(RA) ;PLACE IN INPUT OF DELAY LINE.
02500 JRST 6(RA) ;RETURN.
02600
02700 ;REV2 IS THE ALL-PASS REVERBERATOR.
02800
02900 REV2: AOS INSXR,4(RA) ;CALC. PTR. AS IN REV1.
03000 CAML INSXR,5(RA)
03100 SETZB INSXR,4(RA)
03200 ;; MOVN 1,@3(RA) ;GET NEGATIVE OF OUTPUT OF DELAY.
03300 ;; MOVN 0,@2(RA) ;ALSO NEGATIVE OF GAIN, G.
03400 ;; FMPR 1,0 ;FORM GAIN*OUTPUT
03500 ;; MOVE 2,1 ;(NOTE THIS IS POSITIVE).
03600 ;; FMPR 1,0 ;FORM -G↑2 * OUTPUT.
03700 ;; FADR 1,@3(RA) ;(1-G↑2) * OUTPUT.
03800 ;; FMPR 0,@(RA) ;FORM -G * INPUT.
03900 ;; FADR 1,0 ;FINAL OUTPUT IS -G*IN +(1-G↑2)*OUT.
04000 ;; JRST REVA ;FROM HERE ON, SAME AS REV1.
04005 MOVE 2,@2(RA) ;GET GAIN, G
04010 FMPR 2,@(RA) ;MULTIPLY BY INPUT
04015 FADR 2,@3(RA) ;ADD IN OUTPUT OF DELAY
04020 MOVN 1,2 ;TAKE -(OUTPUT+G+IN)
04025 FMPR 1,@2(RA) ;SCALE BY GAIN
04030 FADR 1,@(RA) ;ADD INPUT
04035 JFCL 1,[SETZB 2,1 ;FLOATING UNDERFLOW
04040 SETOM FXUFLG#
04045 JRST .+1]
04050 MOVEM 1,@3(RA) ;NEW DELAY INPUT
04055 JRST 6(RA) ;RETURN WITH ANSWER IN 2
04060 ; NEW REV. 1 LESS MULT. A.MOORER, 5/74
04100
04200 ; THIS IS THE I-TIME CODE FOR REV1 AND REV2.
04300
04400 REVI: HRRZ T1,(RA) ;GET PTR. TO END OF REV PARAMS.
04500 MOVNI INSXR,1 ;INSXR←-1
04600 HRRZ @-4(T1) ;GET -1ST ELEMENT OF ARRAY (THE LENGTH)
04700 MOVEM -2(T1) ;PLACE IN THE SECOND DUMMY PARAM.
04800 SKIPN REVINI ;SHOULD WE INIT. THE DELAY ARRAY ?
04900 JRST 1(RA) ;NO.
05000 SETZM -3(T1) ;YES. FIRST CLEAR THE POINTER LOC.
05100 HRRZ T,-4(T1) ;GET PTR. TO ARRAY.
05200 REVI2: ADDI -1(T) ; 0 NOW POINTS TO TOP OF ARRAY.
05300 HRL T,T
05400 SETZM (T) ;CLEAR FIRST ELEMENT OF ARRAY.
05500 ADDI T,1 ;FORM BLT POINTER.
05600 BLT T,@0 ;CLEAR REST OF ARRAY.
05700 JRST 1(RA)
05800
00100 ;; MORE GENERATORS.
00200
00300 LINEN: MOVE INSXR,11(RA) ;GET INCREMENT.
00400 ; FADB INSXR,10(RA) ;ADD TO POINTER.
00500 FADB INSXR,@10(RA) ;NOW YOU MUST RESET PTR
00600 LINEN4: CAML INSXR,12(RA) ;ARE WE PAST END OF SECTION ?
00700 JRST LINEN2 ;YES.
00800 FIX INSXR,233000
00900 MOVE T,@3(RA) ;AMPLITUDE.
01000 FMPR T,@7(RA) ;MULT. BY ARRAY ELEMENT.
01100 JRST 13(RA) ;RETURN.
01200
01300 LINEN2: MOVE T,12(RA) ;PICK UP CURRENT LIMIT.
01400 FIX T,242000
01500 CAIL T,3 ;END OF ARRAY ?
01600 JRST LINEN3 ;YES.
01700 HRLI T,RA ;PREPARE FOR INDEXING...
01800 MOVE @T ;PICK UP NEXT INCREMENT.
01900 MOVEM 11(RA) ;PUT AWAY.
02000 MOVSI (128.0)
02100 FADM 12(RA) ;INCREMENT LIMIT TO NEXT VALUE.
02200 JRST LINEN4
02300 LINEN3: MOVEI 14(RA) ;FAKE UP A PARAMETER FOR LINEN1.
02400 MOVEM .+2
02500 JSA RA,LINEN1 ;RE-INITIALIZE THE GENERATOR.
02600 0 ;
02700 ; SETZM 10(RA) ;RESET PTR.
02800 SETZM @10(RA) ;NOW YOU MUST RESET PTR
02900 SETZM 11(RA) ;AND INCREMENT.
03000 SETZM 12(RA) ;...AND LIMIT.
03100 JRST LINEN
03200
03300 LINEN1: 0 ;THE INITIALIZING CODE FOR LINEN.
03400 MOVE T2,(RA) ;GET POINTER TO END OF PARAMETERS.
03500 MOVE T1,TIMESC ;CALC. 128*(BEATS/SAMPLE)
03600 FDVR T1,SRATE
03700 FSC T1,7
03800 MOVE T,@-10(T2) ;GET RISE TIME IN BEATS.
03900 FDVRM T1,T ;INCREMENT←T1/TIME (=128/(TIME IN SAMPS))
04000 MOVEM T,-14(T2) ;PLACE IN PARAMETER 0.
04100 MOVE T,@-6(T2) ;DURATION OF NOTE IN BEATS...
04200 FSBR T,@-7(T2) ;...MINUS FALL TIME..
04300 FSBR T,@-10(T2) ;...MINUS RISE TIME.
04400 FDVRM T1,T ;CHANGE TO INCREMENT.
04500 MOVEM T,-13(T2) ;PLACE IN PARAMETER 1.
04600 FDVR T1,@-7(T2) ;INCREMENT FOR FALL TIME.
04700 MOVEM T1,-12(T2) ;PLACE IN PARAMETER 2.
04800 JRA RA,1(RA)
04900
05000 VALUE: MOVE T,@(RA) ;DUMMY UNIT GENERATOR... OUTPUT IS
05100 JRST 1(RA) ;SAME AS ITS PARAMETER.
05200
00100 ;; RANDOM NUMBER GENERATORS.
00200
00300 RANDH: MOVE @1(RA) ;GET INCREMENT.
00400 FADB 2(RA) ;INCREMENT THE 'POINTER'.
00500 CAML [512.0] ;OVER 512 ?
00600 JRST RNDH2 ;YES. GO GET NEW RANDOM NUMBER.
00700 MOVE T,@(RA) ;NO. GET INPUT ...
00800 FMPR T,3(RA) ;... AND MULT. BY CURRENT RANDOM NO.
00900 JRST 4(RA) ;RETURN.
01000 RNDH2: MOVSI (-512.0) ;CAUSE 'POINTER' TO 'WRAP AROUND'.
01100 FADM 2(RA)
01200 PUSHJ P,RAND ;GET NEW RANDOM NO.
01300 MOVEM T,3(RA) ;MAKE IT THE CURRENT NO.
01400 FMPR T,@(RA) ;MULT. BY INPUT.
01500 JRST 4(RA) ;RETURN.
01600
01700 IRANDI: ;I-TIME CODE FOR RANDI AND RANDH.
01800 IRANDH: PUSHJ P,RAND ;INIT. RANDH.
01900 MOVE T2,(RA) ;GET PTR. TO LAST PARAM..
02000 MOVEM T,-2(T2) ;PUT INITIAL RAND. NO. IN.
02100 JRST 1(RA)
02200
02300 RANDI: MOVE T,2(RA) ;GET CURRENT DELTA..
02400 FADRB T,4(RA) ;ADD TO LAST OUTPUT VALUE...
02500 SOSG 3(RA) ;DECREMENT STEP COUNTER ...
02600 JRST RNDI2 ;IT'S 0, SO GET NEW RANDOM NO.
02700 FMPR T,@(RA) ;NO. MULT BY INPUT.
02800 JRST 5(RA) ;RETURN.
02900 RNDI2: PUSHJ P,RAND ;GET NEXT RANDOM NO.
03000 FSBR T,4(RA) ;FORM DELTA (=NEW - OLD)
03100 MOVSI T1,(512.0)
03200 FDVR T1,@1(RA) ;NO. OF STEPS = 512/(FREQ. INPUT)
03300 FDVR T,T1 ;CHANGE PER STEP =DELTA/NO. OF STEPS
03400 MOVEM T,2(RA) ;STORE CHANGE PER STEP.
03500 FIX T1,233000
03600 MOVEM T1,3(RA) ;PUT IT AWAY.
03700 JRST RANDI ;NOW GO GENERATE FIRST STEP.
03800
03900 RAND: MOVE T,RNDNO1 ;GENERATE A RANDOM NO.
04000 ADD T,RNDNO2
04100 EXCH T,RNDNO2
04200 MOVEM T,RNDNO1
04300 ASH T,-10 ;SMEAR SIGN INTO EXPONENT FIELD..
04400 FSC T,200 ;... AND FLOAT IT IN RANGE -1 TO 1.
04500 POPJ P,
04600 RNDNO1: 756132257563
04700 RNDNO2: 756132257565
04800
00100 PLIST: BLOCK LPLIST
00200
00300 OSTK: BLOCK LOSTK
00400
00500 RQ1: BLOCK LRQ ;THE RUN QUEUE, CLOUMN ONE.
00600 RQ2: BLOCK LRQ ;COLUMN TWO.
00700
00800 PATCH: BLOCK 100
00900
01000 IARR1: ;; HERE BEGINS AN AREA WHICH IS ZEROED DURING
01100 ; INITIALIZATION OF EACH COMPILATION.
01200
01300 UOTBL: BLOCK LUOTBL
01400
01500 ACS:
01600 RACS: BLOCK 20
01700 IACS: BLOCK 20
01800
01900 UOPTR: -1
02000
02100 IARR2:
02200
02300 PBASE: BLOCK LPA
02400
02500 OUTA: 0 ;CHANNEL A OUTPUT SAMPLE ACCUMULATED HERE.
02600 OUTB: 0 ;CHANNEL B.
02700 OUTC: 0 ;CHANNEL C.
02800 OUTD: 0 ;CHANNEL D.
02900
03000 RDA: 0
03100 RDB: 0
03200 RDC: 0
03300 RDD: 0
03400
03500 IARR3:
03600
03700
03800 VLOC: 0
03900 ILOC: 0
04000 RLOC: 0
04100
04200 DSKMAX: =76*2000*17
04300
00100 ;; THIS IS THE MULTIPLE-FEEDBACK REVERBERATOR.
00200 ;; ITS DELAY TIMES MUST NOT BE R-TIME VARIABLES.
00300
00400 REVX: SOSGE INSXR,15(RA) ; ADVANCE PTR. TO 4TH TAP.
00500 JSP T1,REVX1 ;TIME TO WRAP AROUND....
00600 MOVE T,@16(RA) ;GET DELAY ARRAY OUTPUT FROM 4TH TAP..
00700 FMP T,@10(RA) ;MULT. BY GAIN NO. 4
00800 SOSGE INSXR,14(RA) ;NOW PTR. TO 3RD TAP.
00900 JSP T1,REVX1
01000 MOVE @16(RA) ;... 3RD TAP DELAY OUTPUT...
01100 FMP @6(RA) ;...3RD GAIN...
01200 FAD T,0 ;ACCUMULATE SUM IN T.
01300 SOSGE INSXR,13(RA) ;2ND TAP PTR.
01400 JSP T1,REVX1 ;THIS COULD GET BORING.
01500 MOVE @16(RA)
01600 FMP @4(RA) ;GAIN 2.
01700 FAD T,0
01800 SOSGE INSXR,12(RA) ;ONE MORE CHORUS.
01900 JSP T1,REVX1
02000 MOVE @16(RA)
02100 FMP @2(RA) ;GAIN 1.
02200 FADB T,0 ;T NOW HAS FINAL OUTPUT(=SUM OF
02300 ; TAPS * GAINS).
02400 FAD @(RA) ;ADD OUTPUT TO INPUT ..
02500 SOSGE INSXR,11(RA) ;.. GET PTR. TO INPUT OF DELAY..
02600 JSP T1,REVX1
02700 MOVEM @16(RA) ;AND PUT IT THERE.
02800 JRST 20(RA) ;WOULD YOU BELIEVE 20 PARAMETERS ??!
02900
03000 REVX1: ADD INSXR,17(RA) ;A PTR. HAS UNDERFLOWED; ADD
03100 MOVEM INSXR,@-2(T1) ; LENGTH OF ARRAY TO IT TO WRAP
03200 JRST (T1) ;IT AROUND (AND STORE UPDATED VERSION).
03300
00100
00200 REVXI: MOVE T1,(RA) ;INITIALIZING FOR REVX.. GET PTR. TO PARAMMS.
00300 MOVNI INSXR,1
00400 MOVE @-3(T1) ;GET -1ST ELEMENT OF ARRAY (= ITS LENGTH).
00500 MOVEM -2(T1) ;STORE IN LAST DUMMY PARAM.
00600 SKIPE REVINI ;IF WE ARE INITIALIZING REVERBERATORS,
00700 SETZM -10(T1) ;RESET INPUT PTR. OF DELAY TO BOTTOM OF ARRAY.
00800 MOVSI T,-4 ;NOW WE SET UP THE FOUR DELAY OUTPUT TAP
00900 HRRI T,-7(T1) ;PTRS. THE RIGHT DISTANCE BEHIND THE INPUT PTR.
01000 MOVEI T2,-20(T1) ;
01100 REVXI2: MOVE @(T2) ;PICK UP DELAY TIME (IN SAMPLES).
01200 FIX 233000
01300 ADD -10(T1) ;ADD TO INPUT PTR. POSITION.
01400 CAML -2(T1) ;WRAP AROUND ?
01500 SUB -2(T1) ;YES. SUB. LENGTH OF ARRAY.
01600 MOVEM (T) ;PLACE PTR. IN RIGHT DUMMY PARAM.
01700 ADDI T2,2 ;INC. T2 TO POINT AT NEXT DELAY TIME PARAM.
01800 AOBJN T,REVXI2 ;LOOP TO GET ALARRAY (= ITS LENGTH).
01900 SKIPN REVINIT ;ARE WE INITIALIZING REVERBERATORS ?
02000 JRST 1(RA) ;NO. RETURN.
02100 MOVE -2(T1) ;YES GET LENGTH OF ARRAY.
02200 HRRZ T,-3(T1) ;GET BASE OF ARRAY.
02300 JRST REVI2 ;GO ZERO ARRAY (SEE REV1 AND REV2 PAGE).
02400
00100 ; ***** COMPX BEGINS HERE **** ROUTINES TO EMIT CODE AND STUFF TO OUTPUT BUFFERS.
00200 EMDV: SETZB A,B ;EMIT A DUMMY VARIABLE (TO RESERVE
00300 ; SPACE IN THE VARIABLES AREA).
00400 EMVCDI: AOS VLOC
00500 EMVCD: MOVEI T1,2 ;EMIT TO VARIABLE BUFFER.
00600 JRST ECD
00700 EMIABS: TDZA B,B ;EMIT TO I-TIME BUF. , NO RELOC.
00800 EMCDI: AOSA RLOC ;SKIP INSTRUCTIONS WIN BIG.
00900 EMICDI: AOSA ILOC ; SEE THE HAPPY INTERLEAVED CODE !
01000 EMCD: TDZA T1,T1 ;EMIT TO RUNTIME BUFFER.
01100 EMICD: MOVEI T1,1 ;EMIT TO INITIALIZE TIME BUFFER.
01200 ECD:
01300 IDPB A,EMPTR(T1) ;EMIT THE WORD.
01400 IDPB B,RELPTR(T1) ;ALSO ITS RELOCATION BITS.
01500 AOSGE BUFCNT(T1) ;IS BUFFER FULL ?
01600 POPJ P, ;NO. RETURN.
01700
01800 GBUF: ; BUFFER IS FULL; GET A NEW ONE.
01900 MOVNI T,LOBUFS ;LENGTH OF A BUFFER.
02000 PUSHJ P,GFS ;GET SOME FREE STORAGE(WHILE IT LASTS!)
02100 HRLI T,400 ;MAKE BYTE PTR.
02200 MOVEM T,RELPTR(T1) ;PTR. FOR RELOCATION BITS.
02300 MOVEI T2,LOBUFS/12+2(T) ;LEAVE ROOM FOR REL. BITS
02400 HRRM T2,EMPTR(T1) ;DATA PTR.
02500 HRRZM T,@OBPTR(T1) ;FIX UP FORWARD LINKS.
02600 HRRZM T,OBPTR(T1)
02700 SETZM @OBPTR(T1)
02800 MOVNI LOBUFS-LOBUFS/12-3
02900 MOVEM BUFCNT(T1) ;SET UP WORD COUNT.
03000 POPJ P,
03100
03200 EMPTR: POINT 36,0,35 ;DATA OUTPUT POINTERS.
03300 EMIPTR: POINT 36,0,35
03400 EMVPTR: POINT 36,0,35
03500 RELPTR: POINT 4,0 ;RELOC. BITS PTRS.
03600 RELIPT: POINT 4,0
03700 RELVPT: POINT 4,0
03800
03900 OBPTR: BLOCK 3 ;PTR. TO FIRST WORD OF CURRENT BUFFER FOR
04000 ; USE IN FIXING UP FORWARD LINKS.
04100 BUFCNT: BLOCK 3 ;WORD COUNTS FOR BUFFERS.
04200
04300 FCBUF: 0 ;PTR. TO FIRST BUFFER IN EACH CHAIN.
04400 FICBUF: 0
04500 FVCBUF: 0
04600
04700 GFS: ADD T,JOBSYM ;DECREMENT BOTTOM OF FREE STORAGE.
04800 HRRZ JOBFF
04900 CAIL (T) ;ROOM LEFT ?
05000 ERROR (STORAGE FULL) ;NO.
05100 MOVEM T,JOBSYM
05200 POPJ P,
05300
00100 ;THIS HERE IS THE COMPILER !
00200 ; RECURSIVE EXPRESSION ANALYZER.
00300
00400 SEXPR: PUSHJ P,SCAN
00500 EXPR: PUSHJ P,TERM ;<EXPR> = <TERM> ! <TERM><ADDOP><EXPR>
00600 EXPR1: TLNE A,DF ;A DELIMITER NEXT ?
00700 TLNN A,ADDBIT ;YES. AN ADD OR SUBTRACT OP. ?
00800 POPJ P, ;NO.
00900 PUSH P,A ;YES. LOOK FOR ANOTHER TERM.
01000 PUSHJ P,STERM ;THIS IS ITERATIVE INSTEAD OF
01100 ; RECURSIVE IN ORDER TO PROCESS FROM LEFT TO
01200 EXCH A,(P) ; RIGHT.
01300 PUSHJ P,(A) ;CALL APPROPRIATE GENERATOR.
01400 POP P,A
01500 JRST EXPR1
01600
01700 STERM: PUSHJ P,SCANV
01800 TERM: PUSHJ P,FACTOR ;<TERM>=<FACTOR>!<FACTOR><MULOP><FACT.>
01900 TERM1: TLNE A,DF ;A DELIMITER NEXT ?
02000 TLNN A,MULBIT ;YES. A MULTIPLY OR DIVIDE OP ?
02100 POPJ P, ;NO.
02200 PUSH P,A
02300 PUSHJ P,SFACTOR
02400 EXCH A,(P)
02500 PUSHJ P,(A)
02600 POP P,A
02700 JRST TERM1
02800
02900 SFACTOR:PUSHJ P,SCANV
03000 FACTOR: JRST PRIMARY ;GOOD ENOUGH FOR NOW ...
03100
03200 SPRIM: PUSHJ P,SCAN
03300 PRIMARY:
03400 JUMPE A,UDIERR ;STILL UNDEFINED ?
03500 TLNN A,DF ;IS IT A SPECIAL CHAR. ?
03600 JRST PRIM3 ;NO.
03700
00100 PRIM2: CAMN A,MINV ;UNARY MINUS ?
00200 JRST PRUMIN ;YES.
00300 CAME A,LPARV ;NO. IT BETTER BE A (.
00400 ERROR (ILLEGAL PRIMARY.)
00500 PUSHJ P,SEXPR ;SCAN AN EXPRESSION.
00600 CAME A,RPARV ;LOOK FOR MATCHING PAREN.
00700 ERROR (MISSING RIGHT PAREN.)
00800 JRST SCAN ;SCAN AND RETURN.
00900
01000 PRUMIN: PUSHJ P,SPRIM ;UNARY MINUS; SCAN A PRIMARY.
01100 PUSH P,A
01200 PUSHJ P,UMGEN ;CALL GENERATOR.
01300 JRST POPAJ ;RESTORE A AND RETURN.
01400
01500 PRIM3: TLNN A,FUNBIT ;THE NAME OF A FUNCTION ?
01600 JRST SVRBL ;NO.
01700 PRFUN: PUSHJ P,FUNCAL ;COMPILE THE FUNCTION CALL.
01800 PUSHJ P,MRKAC0 ;MARK AC0 FULL (VALUE OF FUNCTION).
01900 JRST SCAN ;RETURN.
02000
02100 SVRBL: TLNN A,VRBLBT!SWVBT!NUMFLG!FOOBIT ;SHOULD BE A VARIABLE,ARRAY NAME,NUMBER OR FOO SYM.
02200 ERROR (ILLEGAL PRIMARY)
02300 TLNE A,VRBLBT!NUMFLG!FOOBIT ;IS IT AN ARRAY NAME ?
02400 JRST SVRBL2 ;NO.
02500 HRR A,(A) ;YES. GET R. HALF OF GOOD BITS.
02600 SUBI A,2 ;MAKE IT POINT TO ARRAY[-2].
02700 SVRBL2: PUSH OSP,A ;MAY BE AN ASN. STMT....
02800 TLNE A,NUMFLG+SWVBT ;IF IT IS A NUMBER, IT CAN'T BE
02900 JRST SCAN ;LEFT PART OF ASN. STMT.
03000 SVRBL1: PUSHJ P,SCAN ;GET LEFT ARROW,IF ANY.
03100 CAME A,LARV ;IT IS ONE, ISN'T IT ?
03200 POPJ P, ;NOPE. JUST A GARDEN VARIETY VARIABLE.
03300 PUSHJ P,ASTMT1 ;YES. COMPILE IT.
03400 PUSHJ P,MRKAC ;SINCE ITS A PRIMARY, REMEMBER ITS
03500 JRST POPAJ ;VALUE, THEN RETURN.
03600 ASTMT1: ;; COMPILE ASSIGNMENT STMT...
03700 PUSHJ P,SEXPR ;COMPILE RIGHT PART OF STMT.
03800 EXCH A,(P) ;SAVE 'A' UNDERNEATH RETURN ADR.
03900 PUSH P,A
04000 JRST ASNGEN ;GENERATE THE STORE.
04100
00100 ; PROCESS A FUNCTION CALL.
00200
00300 FUNCAL: PUSH P,RLOC ;SAVE R-TIME CODE LOC. CTR.
00400 HRRZ B,(A) ;GET PTR. TO PARAMETER DESCRIPTORS.
00500 PUSH P,B ;PTR. TO SYMTABLE ENTRY.
00600 PUSH OSP,(B) ;PLACE CALLING INSTR. ON OPND. STK.
00700 PUSH P,[POINT 6,0,35] ;MAKE A PTR. TO THE BYTES
00800 HRRM B,(P) ; OF THE PARAMETER DESRIPTION.
00900 ILDB T,(P) ;GET PARAMTER COUNT.
01000 PUSH P,T
01100 JUMPE T,FNOPR ;IF NO PARAMS., CALL GENERATOR.
01200 PUSHJ P,SCAN ;SWALLOW LEFT PAREN.
01300 CAME A,LPARV ;I HATE PEOPLE WHO DO THIS.
01400 ERROR (MISSING LEFT PAREN.)
01500 PUSHJ P,SCAN ;SCAN FIRST PARAM.
01600 FUNC4: PUSH P,A
01700 FUNC1: ILDB T,-2(P) ;GET NEXT PARAM. DESCRIPTOR.
01800 CAIN T,FDPARB ;IS IT A DUMMY PARAM. ?
01900 JRST FDPAR ;YES.
02000 CAIN T,FDPARC ;OR A TYPE 2 DUMMY ?
02100 JRST FDPAR2 ;YES.
02200 POP P,A ;NO.
02300 JUMPE T,FLPAR ;IF =0,NO MORE PARAMS.
02400 CAME A,RPARV ;NO PARENTHESES OR COMMAS HERE, PLEASE.
02500 CAMN A,COMMAV
02600 ERROR (MISSING PARAMETER)
02700 CAIN T,FAOPAR ;MUST THIS PARAM. BE AN ARRAY NAME ?
02800 JRST FAPAR ;YES.
02900 PUSHJ P,EXPR ;NO, LET IT BE AN EXPRESSION.
03000 FUNC2: CAMN A,COMMAV ;IS IT A COMMA ?
03100 FUNC3: PUSHJ P,SCAN ;YES, ALTHOUGH WE DONT REALLY CARE.
03200 JRST FUNC4
03300
03400 FLPAR: CAME A,RPARV ;LAST PARAM. IS FOLLOWED BY ).
03500 ERROR (MISSING RIGHT PAREN.) ; ... OR ELSE.
03600 FNOPR: PUSHJ P,GFUNC ;CALL GENERATORS.
03700 ILDB A,-1(P) ;GET NO. OF AC CONTAINING RESULT.
03800 SUB P,[XWD 4,4] ;FORGET ABOUT THINGS IN STACK.
03900 POPJ P,
04000
04100 FAPAR: ;PARAMETER IS NAME OF FUNCTION ARRAY.
04200 PUSHJ P,GAPAR ;CALL GENERATOR.
04300 PUSHJ P,SCAN
04400 JRST FUNC2
04500
04600 FDPAR: PUSHJ P,GDPAR ;GENERATE A DUMMY PARAM.
04700 JRST FUNC1
04800 FDPAR2: PUSH OSP,[0] ;EMIT A DUMMY PARAM., BUT WITHOUT
04900 JRST FUNC1 ;ANY INSTR. TO ZERO IT AT I-TIME.
05000
00100 ; HERE ARE THE GLORIOUS, SUPER-INTELLIGENT, SCHIZOPHRENIC
00200 ; CODE GENERATORS. LOOK UPON THEM AND BE AMAZED.
00300
00400 MULGEN: SKIPA T,[FMP] ;GENERATE A MULTIPLY.
00500 ADDGEN: MOVSI T,(<FAD>) ;SEE THE STUPID FAIL !
00600 PUSH P,T
00700 PUSHJ P,GGET1 ;GET ONE OPERAND IN AN AC.
00800 GEN1: POP P,C ;RECOVER THE OPCODE.
00900 GEN2: PUSHJ P,EMINST ;EMIT THE INSTRUCTION.
01000 JRST MRKAC ;MARK THE AC FULL AND RETURN.
01100
01200 DIVGEN: SKIPA T,[FDV] ;GENERATE A DIVIDE ...
01300 SUBGEN: MOVSI T,(<FSB>) ; .. OR A SUBTRACT.
01400 PUSH P,T
01500 PUSHJ P,GGET2 ;GET FIRST OPERAND IN AN AC.
01600 JRST GEN1
01700
01800 UMGEN: PUSHJ P,GMURKA ;UNARY MINUS. GET THE OPERAND.
01900 PUSH P,E
02000 PUSHJ P,GETAC ;GET A FREE AC.
02100 POP P,B ;BRING BACK AC ADDRESS.
02200 MOVSI C,(<MOVN>) ;EMIT GOOD INSTRUCTION.
02300 JRST GEN2
02400
02500 MULOP←←MULGEN
02600 ADDOP←←ADDGEN
02700 SUBOP←←SUBGEN
02800 DIVOP←←DIVGEN
02900
03000 ASNGEN: ;COMPILE STORE FOR ASIGNMENT STMT.
03100 ASNOP: PUSH P,-1(OSP) ;SAVE PTR. TO GOOD BITS OF VRBL.
03200 PUSHJ P,GMURK ;GET EXPR. AND LEFT-PART VARIABLE.
03300 EXCH D,E ;GET THEM IN RIGHT ORDER.
03400 PUSHJ P,GG2 ;GET EXPR. IN AN AC.
03500 POP P,T ;RECOVER PTR. TO VRBL. GOOD BITS WORD...
03600 MOVE H
03700 LSH =35-PRVBT ;PUT R-TIME FLAG IN RIGHT POSITION...
03800 TLNN B,GPBIT ;IF NOT A P-SYMBOL,
03900 ORM (T) ;SET R-TIME BIT CORRECTLY.
04000 MOVSI C,(<MOVEM>) ;EMIT A MOVEM TO STORE VALUE OF EXPR.
04100 JRST EMINST
04200
04300
00100 ; HA! I BET YOU THOUGHT WE WERE DONE, DIDN'T YOU ?
00200
00300 ; WELL, HERE BEGINS AN INFINITE REGRESSION OF
00400 ; CLEVER ,GRUBBY ROUTINES WHICH DO THE
00500 ; DIRTY WORK FOR THE GENERATORS.
00600
00700 ; GPONDER REMOVES THE TOP THING FROM THE OPERAND STACK,
00800 ; LOVINGLY PATS ITS MAGIC BITS INTO STANDARD FORMAT,
00900 ; AND SETS A FLAG INDICATING WHETHER IT IS AN
01000 ; R-TIME VARIABLE OR NOT.
01100
01200 GPONDER: MOVEI H,0 ;RESET R-TIME VARIABLE FLAG.
01300 GPOND1: POP OSP,T ;GET TOP THING.
01400 TLNE T,FOOBIT ;IS IT A FOO-SYMBOL?
01500 JRST GPFOO ;YES.
01600 TLNE T,NUMFLG ;A NUMBER ?
01700 POPJ P, ;YES. WE ARE DONE.
01800 TLNE T,SRACBT+RVBT ;AN R-TIME AC OR VARIABLE ?
01900 MOVEI H,1 ;YES. SET R-TIME FLAG.
02000 TLNE T,SRACBT ;AN R-TIME AC ?
02100 SETZM RACS(T) ;YES. MARK IT FREE.
02200 TLNE T,SIACBT ;(SAME FOR I-TIME AC).
02300 SETZM IACS(T)
02400 TLNE T,VRBLBT ;A VARIABLE ?
02500 HRR T,(T) ;YES. GET RT. HALF GOOD BITS.
02600 POPJ P,
02700 GPFOO: TRZE T,400000 ;IS IT A P-SYMBOL?
02800 JRST GPONP ;YES.
02900 GPONU: MOVEI H,1 ;REFERS TO A UINIT GENERATOR; SET FLG.
03000 HRRZS T ;GET NO. OF UNIT GEN.
03100 CAMLE T,UOPTR ;NO FORWARD REFERENCES TO UNIT GEN.
03200 ERROR (FORWARD REF. TO UNIT GENERATOR)
03300 MOVE T,UOTBL(T) ;GET ADDRESS OF ITS OUTPUT CELL.
03400 POPJ P,
03500
03600 GPONP:
03700 ADDI T,PBASE ;BASE OF PARAM. ARRAY.
03800 HRLI T,GPBIT ;MARK AS P-SYMBOL.
03900 POPJ P,
04000
04100
00100 ; GMURK CLEVERLY GPONDERS THE TOP TWO OPERANDS,
00200 ; AND IF ONE OF THEM IS AN R-TIME VARIABLE
00300 ; AND THE OTHER IS AN I-TIME AC OR A P-SYMBOL, IT STORES
00400 ; THE LATTER WHERE IT WILL BE SAFE UNTIL R-TIME.
00500
00600 GMURKA: MOVEI H,0
00700 GMURK1: TDZA T,T ;PROCESS ONLY TOP STACK ELEMENT.
00800 GMURK: PUSHJ P,GPONDER ;GPONDER THE FIRST OPERAND.
00900 PUSH P,T ;SAVE IT
01000 PUSHJ P,GPOND1 ;NOW THE SECOND.
01100 POP P,D ;PUT THEM BOTH IN SOME SAFE ACCUMULATORS.
01200 MOVE E,T
01300 SKIPN H ;IS EITHER ONE AN R-TIME VARIABLE ?
01400 POPJ P, ;NO.
01500 TLNE E,SIACBT+GPBIT ;AN I-TIME AC OR A P-SYMBOL ?
01600 JRST GM2 ;YES.
01700 TLNN D,SIACBT+GPBIT ;HOW ABOUT THIS ONE ?
01800 POPJ P, ;HE ISN'T, EITHER. RETURN.
01900 SKIPA F,[EXP D] ;BAGBITING MACROX.
02000 GM2: MOVEI F,E ;SEE THE TWO HEADED MONSTER.
02100 MOVE A,(F) ;GET THE RELEVANT THING.
02200 TLNE A,GPBIT ;A P-SYMBOL, OR AN I-TIME AC ?
02300 JRST GM3 ; A P-SYMBOL.
02400 MOVE B,VLOC ;STORE IT IN VARIABLE AREA.
02500 GM3B: MOVEM B,(F) ;CHANGE THE OPERAND INDICATOR.
02600 MOVE C,[MOVEM EMICDI] ;EMIT THE STORE INSTRUCTION.
02700 PUSHJ P,EMINST
02800 JRST EMDV ;MAKE APLACE IN THE VARIABLES FOR IT.
02900
03000 GM3: SKIPN T1,(A) ;HAS THE PARAMETER ALREADY BEEN
03100 JRST GM3A ; PUT IN VAR. AREA ?
03200 MOVEM T1,(F) ;YES. CHANGE POINTER.
03300 POPJ P,
03400
03500 GM3A: PUSHJ P,GETIAC ;FIND FREE I-TIME AC.
03600 MOVE B,(F)
03700 MOVE T,VLOC ;GET VAR. LOC. CTR.
03800 TLO T,GPBIT
03900 MOVEM T,(B) ;ENTER IN PARAMTER TABLE.
04000 MOVE C,[MOVE EMICDI] ;EMIT INSTR. TO
04100 PUSHJ P,EMINST ;PICK UP THE PARAMETER.
04200 MOVE B,VLOC ;GET LOC. AGAIN...
04300 TLO B,GPBIT ;MARK AS A P-SYMBOL.
04400 JRST GM3B ;NOW STORE THE PARAMETER IN VAR. AREA.
04500
04600
00100 ; STILL MORE KLUGES. PAUSE TO GET YOUR BREATH NOW.
00200 ;GGET1 ARRANGES TO HAVE ONE OF THE TOP TWO OPERANDS
00300 ; IN AN AC. IT RETURNS IN 'A' THE ADDRESS OF THAT AC, AND
00400 ; IN 'B' THE ADDRESS OF THE OTHER OPERAND, WITH RELOCATION
00500 ; BITS IN LEFT HALF.
00600
00700 GGET1: PUSHJ P,GMURK ;PROCESS TOP TWO OPERANDS.
00800 TLNN D,SIACBT+SRACBT ;IS FIRST ONE IN AN AC ?
00900 JRST GG2 ;NO.
01000 MOVE A,D ;YES. WE ARE DONE.
01100 MOVE B,E
01200 POPJ P,
01300 GGET2: PUSHJ P,GMURK ;GGET2 GETS SECOND OPERAND IN AN AC.
01400 GG2: MOVE A,E ;PUT OPERAND IN A.
01500 TLNE A,SIACBT+SRACBT ;IS IT ALREADY IN AN AC ?
01600 JRST GL2A ;YES. WIN BIG.
01700 TLNE D,SIACBT+SRACBT ;HOW ABOUT OTHER OP. ?
01800 SETOM @ACTB3(H) ;AN AC... MARK IT FULL TEMPORARILY.
01900 PUSHJ P,GETAC ;GET A FREE AC OF THE APPROPRIATE KIND.
02000 MOVE B,E ;LOAD SECOND OPERAND INTO IT.
02100 MOVSI C,(<MOVE>) ;EMIT LOAD INSTR.
02200 PUSHJ P,EMINST
02300 TLNE D,SIACBT+SRACBT ;IF OTHER OP. IS IN AN AC,
02400 SETZM @ACTB3(H) ;MARK IT FREE NOW.
02500 GL2A: MOVE B,D ;PUT OTHER OP IN B.
02600 POPJ P,
02700
02800 ; EMINST IS THE INSTRUCTION EMITTING ROUTINE. CALL IT
02900 ; WITH AC IN A,THE ADDRESS (+ RELOC. BITS) IN B, AND
03000 ; OPCODE IN C. IF RIGHT HALF OF C IS NON-ZERO, IT IS THE
03100 ; ADDRESS OF THE APPROPRIATE BUFFER EMITTING ROUTINE;
03200 ; OTHERWISE THE INSTR. IS PLACED IN THE I-TIME
03300 ; OR R-TIME BUFFERS ACCORDING TO THE STATE OF THE FLAG IN H.
03400
03500 EMINST: PUSH P,A ;SAVE IT.
03600 HLL A,C ;ASSEMBLE INSTRUCTION IN A.
03700 DPB A,[POINT 4,A,12] ;PUT IN AC FIELD.
03800 HRR A,B ;ALSO ADDRESS.
03900 TLZE B,FPARBT ;IS ADDR. A FORMAL PARAMETER ?
04000 TLO A,20+RA ;YES. ADD INDIRECT BIT AND INDEX.
04100 HLRZS B ;PUT RELOC. BITS FOR ADDRESS IN RIGHT HALF OF B.
04200 PUSH P,[EXP EMIN2] ;RETURN ADDRESS.
04300 TRNE C,-1 ;RH OF C =0 ?
04400 JRST (C) ;NO.
04500 JRST @EMITB(H)
04600 POPAJ: ;A USEFUL ENTRY POINT.
04700 EMIN2: POP P,A
04800 POPJ P,
04900 EMITB: EMICDI
05000 EMCDI
05100 ACTB3: XWD D,IACS
05200 XWD D,RACS
05300
00100 ;GETAC SEARCHES FOR A FREE AC, EITHER I-TIME OR
00200 ; R-TIME, AS INDICATED BY THE STATE OF THE FLAG IN H.
00300
00400 GETAC: SKIPE H ;ARE WE EMITTING R-TIME CODE ?
00500 GETRAC: SKIPA T3,[XWD SRACBT+A,RACS] ;YES, FIND A R-TIME AC.
00600 GETIAC: MOVE T3,[XWD SIACBT+A,IACS] ;FIND AN I-TIME AC.
00700 MOVE A,[XWD -NACS,NFACS] ;CONSIDER ONLY AC'S 4-14
00800 TRNE FL,CSBRBT ; ..UNLESS WE'RE COMPILING A FUNCTION..
00900 MOVE A,[XWD -NFACS,0] ;WE ARE. CONSIDER ONLY 0-3.
01000 SKIPE @T3 ;INDIRECT ADDRESSING IS GOOD FOR YOU.
01100 AOBJN A,.-1 ;NOT FREE. TRY FOR NEXT ONE.
01200 JUMPLE A,GETAC3 ;DID WE FIND ONE ?
01300 PUSHJ P,GETAC2 ;NO. STORE ONE.
01400 GETAC3: HRLI A,SRACBT ;YES. PUT IN APPROPRIATE FLAG BITS.
01500 TLNN T3,SRACBT ;OOPS, IT'S AN I-TIME AC.
01600 HRLI A, SIACBT
01700 POPJ P,
01800
01900 GETAC2: SUBI A,1 ;STORE HIGHEST AC.
02000
02100 GSVAC: MOVE T,@T3 ;FIND OUT WHO'S IN HIM.
02200 MOVE B,VLOC ;GET LOC. TO STORE HIM IN.
02300 MOVEM B,(T) ;FIX UP HIS STACK ENTRY.
02400 SETZM @T3 ;MARK HIM EMPTY.
02500 MOVSI C,(<MOVEM>) ;EMIT THE STORE INST.
02600 PUSHJ P,EMINST
02700 JRST EMDV ;LEAVE A PLACE IN VARIABLES AREA.
02800
02900 ;MRKAC PUTS THE AC SYMBOL IN A BACK ON THE STACK AND MARKS
03000 ; THE CORRESPONDING AC AS FULL.
03100
03200 MRKAC0: IOR A,MRKTAB(H) ;MARK IAC 1 OR RAC 1 FULL.
03300
03400 MRKAC: PUSH OSP,A ;PUT IT ON STACK.
03500 TLNN A,SRACBT ;AN R-TIME AC?
03600 HRRZM OSP,IACS(A) ;NO, MARK CORRESPONDING I-TIME AC FULL.
03700 TLNE A,SRACBT
03800 HRRZM OSP, RACS(A)
03900 CPOPJ: POPJ P,
04000
04100 MRKTAB: XWD SIACBT,0 ;DESCRIPTOR FOR I-TIME AC NO. 1
04200 XWD SRACBT,0 ;R-TIME AC 1.
04300
04400
00100 ;; MORE GENERATORS.
00200
00300 GAPAR: ;; HANDLE A PARAMETER WHICH IS AN ARRAY NAME.
00400 TLNE A,SWVBT ;IS IT AN ARRAY IDENTIFIER OR
00500 HRR A,(A)
00600 TLNE A,FPARBT+SWVBT ; A FORMAL PARAMETER ?
00700 JRST GAPR1 ;YES.
00800 TLNE A,FOOBIT ;BETTER BE A FOO-SYMBOL, THEN....
00900 TRZN A,400000 ;FURTHERMORE, IT MUST BE A P-SYM.
01000 ERROR(IMPROPER ARRAY PARAMETER)
01100 PUSH P,A ;SAVE P NO.
01200 PUSHJ P,GETIAC ;FIND FREE I-TIME AC.
01300 POP P,B
01400 ADDI B,PBASE ;CALC. ADDR. OF P-SYMBOL.
01500 MOVE C,[MOVE EMICDI] ;EMIT MOVE AC,P-SYMBOL TO THE
01600 PUSHJ P,EMINST ;I-TIME CODE STREAM.
01700 HRLI A,(<MOVEM>) ;NOW A MOVEM AC, INTO THE PARAMETER
01800 DPB A,[POINT 4,A,12] ;LOCATION.
01900 TRZA A,-1 ;CLEAR ADDRESS FIELD.
02000 GDPAR: MOVSI A,(<SETZM>) ;PARAM. LIST AT I-TIME.
02100 PUSH OSP,ILOC ;PUT ARRAY MARKER IN OPERAND
02200 MOVSI T,SWVBT+FPARBT ;STACK SO A FIXUP CAN BE EMITTED TO
02300 IORM T,(OSP) ;THE UPCOMMING HRRM WHEN THE PARAMETERS
02400 MOVEI B,0 ;NO RELOCATION, PLEASE.
02500 JRST EMICDI ;EMIT HRRM TO STORE ARRAY LOC. INTO
02600 ;PARAMETER CELL, AND RETURN.
02700 GAPR1: PUSH OSP,A ;PLACE IN OPERAND STACK.
02800 POPJ P,
02900
00100 GFUNC: ;; GENERATE A FUNCTION CALL.
00200 MOVE A,@-3(P) ;PICK UP THE CALLING INSTR. FOR THE FUNCTION.
00300 MOVE D,RLOC ;DECIDE WHETHER CALL IS TO BE IN
00400 MOVEI H,0 ;R-TIME OR I-TIME CODE.
00500 TLZN A,20 ;IND. BIT IN INSTR. SAYS R-TIME ALWAYS.
00600 CAME D,-4(P) ;ALSO R-TIME IF ANY R-TIME PARAMETERS
00700 MOVEI H,1 ;HAVE BEEN COMPILED.
00800 GFUNC8: MOVE T3,ACTB1(H)
00900 MOVSI A,-NFACS ;PREPARE TO SEARCH AC'S 0-4.
01000 SKIPN T,@T3 ;IS THIS ONE IN USE ?
01100 AOBJN A,.-1 ;NO.
01200 JUMPG A,GFUNC6 ;DID WE FIND A BUSY ONE ?
01300 PUSHJ P,GSVAC ;YES. SAVE IT.
01400 JRST GFUNC8
01500 GFUNC6: PUSH P,-1(P) ;PUT PAR. COUNT ON STACK.
01600 HRRZM P,TEMP1# ;SAVE LOC. OF COUNT.
01700 GFUNC5: SOSGE @TEMP1 ;MORE PARAMS ?
01800 JRST GFUNC4 ;NO.
01900 PUSHJ P,GMURK1 ;GET A PARAM.
02000 TLNN E,SWVBT
02100 TLNN E,FPARBT ;IS IT A FORMAL PARAMETER ?
02200 JRST GFUNC7 ;NO, THANK GOD.
02300 MOVE A,E ;SIGH. THE PRICE OF HONESTY ...
02400 HRLI A,(<MOVE (RA)>) ;EMIT CODE TO PICK UP THE
02500 MOVEI B,0 ;PARAM. PTR. AND PUT IT IN THE
02600 PUSHJ P,@EMITB(H) ;CURRENT CALLING SEQUENCE.
02700 MOVE E,ILOC(H) ;SAVE ILOC OR RLOC FOR LATER FIXUP.
02800 TLO E,FPARBT ;MIGHT AS WELL USE THIS BIT...
02900 MOVSI A,(<MOVEM>) ;NOW THE SECOND INSTR....
03000 PUSHJ P,@EMITB(H)
03100 GFUNC7: PUSH P,E ;SAVE IT.
03200 JRST GFUNC5 ;GET ANOTHER.
03300 GFUNC4: POP OSP,A ;NOW EMIT THE CALLING INSTR.
03400 GFUNC2: LDB B,[POINT 4,A,17] ;RELOC. BITS.
03500 TLZ A,37
03600 TLZE A,SWVBT ;IS IT AN ARRAY NAME ?
03700 TLO A,INSXR ;YES. ADD INDEX FIELD.
03800 GFUNC3: PUSHJ P,@EMITB(H) ;
03900 POP P,A ;GET PARAM. FROM STACK.
04000 JUMPL A,CPOPJ ;IF IT'S THE MARK, RETURN.
04100 TLZN A,FPARBT ;IS IT A FORMAL PARAMETER ?
04200 JRST GFUNC2 ;NO. EMIT IT.
04300 MOVEI B,.FXBTS ;YES. EMIT A FIXUP TO THE RIGHT INSTRUCTION.
04400 TLZ A,400000+LRFXBT+SWAPBT ;A REPLACEMENT FIXUP TO RT. HALF.
04500 TLO A,RRFXBT
04600 PUSHJ P,@EMITB2(H) ;EMIT IT TO I-TIME OR R-TIME BUFER.
04700 MOVEI B,0 ;NOW RESERVE SPACE FOR THE PARAM.
04800 JRST GFUNC3
04900 EMITB2: EMICD
05000 EMCD
05100 ACTB1: XWD SIACBT+A,IACS ;PTR. TO IACS,INDEXED BY B.
05200 XWD SRACBT+A,RACS
05300
00100 ;; UTILITY RUOTINE TO ENTER AN ITEM IN THE MAIN SYMBOL TAB.
00200
00300 GETNAM: PUSHJ P,SCANV ;SCAN AN IDENTIFIER.
00400 GETNM1: AOS T,(P) ;TO SKIP PARAM ON RETURN.
00500 JUMPE A,GNM2 ;SHOULD BE UNDEFINED...
00600 TLOE A,DF ;IT'S NOT. MAYBE IT'S A DELIMITER ?
00700 ERROR (MISSING IDENTIFIER)
00800 TLNN A,@-1(T) ;NO. MAYBE ALREADY RIGHT TYPE ?
00900 ERROR (MULTIPLY DEFINED SYMBOL)
01000 SKIPGE -1(T) ;AH, IT IS. SHOULD WE REENTER IT ?
01100 POPJ P, ;NO. ITS OLD ENTRY WILL DO.
01200 GNM2: HRLZ A,-1(T) ;YES. GET TYPE BITS.
01300
01400 AENTER: HRRZ JOBFF ;GET NEXT FREE LOCATION.
01500 HRRZ B,CBNO ;GET BUCKET NO. OF THING JUST SCANNED.
01600 EXCH BUCTBL(B) ;UPDATE BUCKET HEAD.
01700 AOS B,JOBFF
01800 MOVEM -1(B) ;PUT THE LINK IN THE NEW ENTRY.
01900 MOVEM A,1(B) ;PUT THE RANDOM GOOD BITS IN.
02000 MOVE ACCUM ;GET FIRST WORD OF NAME.
02100 MOVEM (B) ;PUT IN TABLE.
02200 AOS B,JOBFF
02300 MOVEI T,ACCUM+1 ;PREPARE TO MOVE REST OF NAME.
02400 AEL1: AOS JOBFF
02500 SKIPN T1,(T) ;ANY MORE OF THE NAME ?
02600 JRST AEL2 ;NO.
02700 MOVEM T1,@JOBFF ;YES. PUT IN TABLE.
02800 CAIL T,ACCUM+2 ;UNLESS FIRST OR SECOND WORD,
02900 SETZM (T) ;ZERO WORD IN ACCUM.
03000 AOJA T,AEL1
03100 AEL2: HRRZ JOBSYM ;GET BOTTOM OF BUFFER AREA.
03200 CAMG JOBFF ;HAVE WE OVERRUN IT ?
03300 ERROR(CORE IS FULL)
03400 HRR A,B
03500 HRRZ JOBFF
03600 HRLM JOBSA
03700 POPJ P,
03800
03900
00100 ;; INITIALIZATION OF THE COMPILER.
00200
00300 EXTERNAL JOBFF,JOBSA
00400 JOBSYM: 0
00500
00600 SCOMPA: MOVE OSP,[XWD -LOSTK,OSTK-1] ;INIT. OPERAND STACK.
00700 PUSH OSP,JOBSYM ;...SO WE CAN RESTORE IT LATER.
00800 MOVSI IRELBT ;INIT THE THREE LOCATION
00900 MOVEM ILOC ;COUNTERS (APPROPRIATE RELOCATION
01000 MOVSI RRELBT ;BITS LIVE IN LEFT HALF OF EACH).
01100 MOVEM RLOC
01200 MOVSI VRELBT
01300 MOVEM VLOC
01400 MOVEI T1,2 ;SET UP THE THREE CHAINS OF OUTPUT
01500 SCMP1: SETZM OBPTR(T1)
01600 PUSHJ P,GBUF ;BUFFERS.
01700 HRRZM T,FCBUF(T1) ;PTR. TO FIRST BUFFER OF CHAIN
01800 SOJGE T1,SCMP1 ;DO FOR ALL THREE CHAINS.
01900 SETZM IARR1 ;ZERO SOME TABLES AND STUFF.
02000 MOVE [XWD IARR1,IARR1+1]
02100 BLT IARR2-1
02200 MOVEI FL,0 ;CLEAR FLAGS.
02300 POPJ P,
02400
02500 SCOMP: PUSHJ P,SCOMPA ;INIT. THE COMPILER.
02600 MOVE [XWD IARR2-1,IARR2]
02700 BLT IARR3-1 ;ZERO REST OF TABLES.
02800 POPJ P,
02900
00100 ;; SYNTAX ANALYZER.
00200
00300 SSTATL: PUSHJ P,SMCSCN ;SCAN NEXT NON-SEMICOLON.
00400 STATL: CAMN A,FINV ;IS IT A FINISH ?
00500 JRST ENDP1 ;YES.
00600 PUSHJ P,STAT ;NO. SCAN A STATEMENT.
00700 JRST SSTATL ;GO BACK FOR MORE.
00800
00900 SSTAT: PUSHJ P,SMCSCN
01000 STAT: MOVEI H,0 ;CLEAR 'R-TIME CODE' FLAG.
01100 JUMPGE A,STAT2 ;A DELIMITER ?
01200 TLNE A,DECLBIT ;YES. A DECLARATION ?
01300 JRST (A) ;YES. DISPATCH TO RIGHT ROUTINE.
01400 STAT2: PUSHJ P,STMT1 ;IT HAS TO BE A STMT1.
01500 STATL1: CAME A,SEMICV ;SEMICOLON AFTER EVERY STMT.,PLEASE.
01600 ERROR (MISSING SEMICOLON) ;I HATE MYSELF FOR THIS.
01700 TDZ FL,[XWD ERRFLG,EXTFLG] ;TURN OFF ERROR FLAG.
01800 POPJ P, ;END OF STATEMENT.
01900
02000 EXTD: PUSHJ P,SCAN ;"EXTERNAL" DECLARATION.
02100 CAME A,FUNV ;BETTER BE "FUNCTION".
02200 ERROR (<EXTERNAL FUNCTIONS ONLY,PLEASE.>)
02300 TRO FL,EXTFLG ;SET FLAG.
02400 JRST DFUNC
02500
02600 SSTMT1: PUSHJ P,SCAN
02700 STMT1: SKIPN A ;IS IT UNDEFINED ?
02800 ERROR (UNDEFINED IDENTIFIER)
02900 STMT1A: TLNE A,FUNBIT ;<STMT1>=<FUNCTION CALL> ! <ASN. STMT>
03000 JRST SFUNC ;A FUNCTION CALL.
03100 TLNN A,VRBLBT!FOOBIT ;BETTER BE A SIMPLE VARIABLE.
03200 ERROR (SIMPLE VARIABLE REQUIRED HERE.)
03300 PUSH OSP,A ;STACK IT.
03400 PUSHJ P,SCAN ;GET LEFT ARROW.
03500 CAME A,LARV
03600 ERROR (ILLEGAL STATEMENT)
03700 PUSHJ P,ASTMT1 ;IT'S AN ASSIGNMENT STMT. COMPILE IT.
03800 JRST POPAJ ;RESTORE A(WHICH WAS SAVED BY ASTMT)
03900 ; AND RETURN.
04000 SFUNC: PUSHJ P,FUNCAL ;COMPILE FUNCTION CALL
04100 JRST SCAN ;RETURN.
04200
04300 SMSC1:
04400 SMCSCN: PUSHJ P,SCAN ;SCAN PAST NEXT SEMICOLON.
04500 SMCS1: CAMN A,SEMICV
04600 JRST SMCSCN
04700 POPJ P,
04800
00100
00200 ENDSTL: RELEAS DT, ;ALL DONE. RELEAS INPUT DEVICE.
00300 ENDP1:
00400 MOVEI A,0
00500 MOVEI B,.FXBTS ;PUT END MARKS IN THE BUFFERS.
00600 PUSHJ P,EMCD
00700 PUSHJ P,EMICD
00800 PUSHJ P,EMVCD
00900 POP OSP,JOBSYM ;RESTORE JOBSYM.
01000 POPJ P,
01100 EXTERNAL JOBDDT,JOBREL
01200
01300 DVRBL1: CAME A,COMMAV ;IS IT A COMMA ?
01400 JRST STATL1 ;NO. END OF DECL.
01500 DVRBL: PUSHJ P,SCAN ;GET NEXT ITEM.
01600 CAMN A,CTBL+"/" ;IS IT A "/" ?
01700 JRST DVRBL2 ;YES. DEFINE FOLLOWING VARIABLE AS R-TIME.
01800 PUSHJ P,GETNM1 ;NO. MUST BE NAME OF VARIABLE. PUT IN SYM. TABLE.
01900 XWD 400000,VRBLBT ;PARAM. TO GETNM1.
02000 DVRBL4: JUMPL A,DVRBL3 ;WAS IT ALREADY DEFINED ?
02100 AOS A,JOBFF ;NO, IT'S NEW. LEAVE WORD FOR THE VALUE.
02200 SUBI A,1 ;GET PTR. TO THAT WORD.
02300 HRRM A,(B) ;PUT IN GOOD BITS WORD (NO REL. BITS).
02400 DVRBL3: PUSHJ P,SCAN ;GET COMMA OR SEMICOLON.
02500 JRST DVRBL1 ;BACK FOR MORE.
02600
02700 DVRBL2: PUSHJ P,GETNAM ;SCAN AND ENTER NAME OF VARIABLE.
02800 XWD 400000,VRBLBT!RVBT ;INCLUDE 'R-TIME' BIT.
02900 JRST DVRBL4
03000
00100 DF5: CAME A,COMMAV ;ARE THERE MORE DEFINITIONS ?
00200 JRST STATL1 ;NO.
00300 DFUNC: TRO FL,CSBRBT+SFOOBT ;ENTER FUNCTION DEFINING MODE.
00400 PUSHJ P,GETNAM ;GET FUNCTION NAME.
00500 EXP FUNBIT ;PARAMETER TO GETNAM.
00600 PUSH P,BUCTBL ;####$$%%$ A TEMPORARY KLUGE !!
00700 MOVE A,JOBFF ;GET FIRST FREE STORAGE LOC.
00800 HRRM A,(B) ;MAKE GOOD BITS WORD POINT THERE.
00900 HRLI A,600 ;MAKE A INTO A BYTE POINTER.
01000 PUSH P,A
01100 PUSH P,A
01200 IBP (P) ;THIS POINTER IS FOR PARAMETER DESCRIPTORS.
01300 HRLI A,400000+LRFXBT+RRFXBT ;NOW EMIT FIXUP TO THE LOCATION IN THE SYM. TABLE WHICH WILL
01400 MOVEI B,.FXBTS ;CONTAIN THE CALLING INSTR. FOR THE FUNCTION, SO IT CAN BE UPDATED AT
01500 PUSHJ P,EMICD ;LOAD TIME WITH THE RELOCATED ADDRESS OF THE FUNCTION.
01600 ADDI A,5 ;LEAVE ENOUGH ROOM FOR 22 PARAMETER
01700 HRRZM A,JOBFF ;DESCRIPTORS.
01800 TRNN FL,EXTFLG ;IS IT AN EXTERNAL FUNCTION ?
01900 SKIPA A,ILOC ;NO. ADDRESS IS IN ILOC.
02000 PUSHJ P,SYMSCH ;YES. FIND STARTING ADDRESS.
02100 TLO A,(<JSA RA,>) ;MAKE INTO A CALLING INSTR.
02200 MOVEM A,@-1(P) ;PLACE IN SYM. TABLE.
02300 LDB B,[POINT 4,A,17] ;GET THE RELOCATION BITS.
02400 TLZ A,17 ;TURN THEM OFF IN THE INSTRUCTION WORD.
02500 PUSHJ P,EMICD ;EMIT AS VALUE OF ABOVE FIXUP.
02600 PUSH P,[-1] ;INIT. THE PARAMETER COUNT.
02700 PUSHJ P,SCAN ;LOOK AT NEXT THING.
02800 CAME A,LPARV ;A ( ?
02900 JRST DFNOPR ;NO. THERE ARE NO PARAMETERS.
03000 DF2: PUSHJ P,SCAN ;SCAN A PARAMETER.
03100 CAME A,ARRV ;IS IT AN ARRAY NAME ?
03200 JRST DF2A ;NO.
03300 TRO FL,ARRFLG ;YUP. SET FLAG AND GET NAME OF
03400 JRST DF2 ;PARAM.
03500
00100 DF2A: TLNE A,DF+NUMFLG
00200 ERROR (ILLEGAL FORMAL PARAMETER)
00300 AOS A,(P) ;INCREMENT PARAMETER COUNT.
00400 HRLI A,FPARBT!VRBLBT ;MAKE A INTO FORMAL PARAM. INDICATOR
00500 PUSHJ P,AENTER ; AND ENTER THE SYMBOL.
00600 MOVEI 2 ;PUT 'ORDINARY' FLAG IN THE PARAMETER
00700 TRZE FL,ARRFLG ;AN ARRAY NAME PARAM. ?
00800 MOVEI 1 ;YES. USE RIGHT DESCRIPTOR BIT.
00900 IDPB -1(P) ;DESCRIPTOR FOR THIS PARAM.
01000 PUSHJ P,SCAN
01100 CAMN A,COMMAV ;A COMMA ?
01200 JRST DF2 ;YES LOOK FOR MORE PARAMETERS.
01300 CAME A,RPARV ;IT BETTER BE A ).
01400 ERROR (MISSING RIGHT PAREN.)
01500 PUSHJ P,SCAN ;GET THE =.
01600 MOVEI B,0 ;FLAG END OF PARAMETER DESCRIPTORS.
01700 IDPB B,-1(P)
01800 DFNOPR: TRNE FL,EXTFLG ;IS THIS AN EXTERNAL FUNCTION ?
01900 JRST DF4 ;YES. LOOK FOR NO DEFINITION.
02000 CAME A,CTBL+"="
02100 ERROR (MISSING = IN FUNCTION DEFINITION)
02200 PUSHJ P,EMICDI ;LEAVE ROOM FOR THE JSA WORD.
02300 TRZ FL,SFOOBT ;LET SCANNER SEE FOO-SYMBOLS AGAIN.
02400 PUSHJ P,SEXPR ;SCAN AN EXPRESSION.
02500 DF4: PUSH P,A
02600 TRNE FL,EXTFLG ;AN EXTERNAL ?
02700 SKIPA E,[XWD SIACBT,0] ;YES. RESULT ALWAYS IN 0.
02800 PUSHJ P,GMURK1 ;GET IT OFF STACK.
02900 PUSHJ P,GG2 ;MAKE SURE ITS IN AN AC.
03000 IDPB A,-2(P) ;TELL UNIVERSE WHICH AC .
03100 AOS B,-1(P) ;ADJUST PARAMETER COUNT.
03200 IDPB B,-3(P) ;PUT IN SYM. TABLE.
03300 MOVEI A,RA ;EMIT RETURN INSTR.
03400 MOVSI C,(<JRA RA,(RA)>)
03500 TRNN FL,EXTFLG ;...UNLESS THIS IS AN EXTERNAL.
03600 PUSHJ P,EMINST
03700 AOS A,-2(P) ;FIND TOP OF PARAM. DESC. STRING.
03800 HRRZM A,JOBFF ;RESET FREE STORAGE.
03900 HRLM A,JOBSA
04000 POP P,A
04100 SUB P,[XWD 3,3] ;FORGET JUNK IN STACK.
04200 POP P,BUCTBL ;##$$%$# MORE OF THAT KLUGE !!!
04300 TRZ FL,CSBRBT+SFOOBT ;LEAVE FUNCTION DEFINING MODE.
04400 JRST DF5 ;ALL DONE.
04500
00100 ;; MORE SYNTAX ANALYZER. COMPILE AN INSTRUMENT DEFINITION.
00200
00300 CINS: PUSHJ P,GETNAM ;GET NAME OF INSTRUMENT.
00400 EXP INSBIT ;PARAMETER TO GETNAM.
00500 AOS A,JOBFF ;GET PLACE FOR MORE GOOD BITS..
00600 SUBI A,1
00700 HRRM A,(B) ;MAKE RANDOM BITS WORD POINT THERE.
00800 HRLI A,RRFXBT ;RIGHT HALF REPLACEMENT TYPE FIXUP.
00900 MOVEI B,.FXBTS ;EMIT FIXUP TO RIGHT HALF FROM
01000 PUSHJ P,EMICD ;FIRST LOC. OF I-TIME CODE.
01100 HRLI A,LRFXBT+SWAPBT ;FIXUP TO LEFT HALF FROM FIRST LOC.
01200 PUSHJ P,EMCD ;OF R-TIME CODE.
01300 CINS5: PUSHJ P,SCAN
01400 CINS3: PUSHJ P,SMCS1 ;IGNORE SEMICOLON, IF ANY.
01500 CAMN A,ENDV ;IS IT AN END ?
01600 JRST CINSE ;YES.
01700 TLNN A,UGBIT ;IS IT A UNIT GENERATOR CALL ?
01800 JRST CINS4 ;NOT A UNIT GENERATOR.
01900 HRRZM A,CINST1# ;SAVE IT.
02000 PUSHJ P,SCAN ;PEEK AT NEXT THING.
02100 CAMN A,CTBL+"[" ;IS IT A [ ?
02200 JRST CUG1 ;YES. UNIT GEN. HAS CONTROLLED CALLING RATE.
02300 MOVEM A,SNCHR ;NO, IT'S PROBABLY THE (. PUT IT BACK WHERE SCAN WILL SEE IT AGAIN.
02400 PUSHJ P,CINS6 ;NOW COMPILE THE CALL ON THE UNIT GEN.
02500 JRST CINS5 ;BACK FOR MORE.
02600
02700 CINS6: MOVE A,CINST1 ;RECOVER POINTER FOR USE OF FUNCAL.
02800 PUSHJ P,FUNCAL ;COMPILE CALL ON THE UNIT GEN.
02900 MOVE B,VLOC ;GET LOC. FOR OUTPUT OF UNIP,SMCS1 ;IGNORE SEMICOLON, IF ANY.
03000 AOS C,UOPTR ;INCREMENT COUNT OF UNIT GENS.
03100 MOVEM B,UOTBL(C) ;ENTER OUTPUT LOC. IN TABLE.
03200 MOVE C,[MOVEM EMCDI] ;EMIT STORE INSTRUCTION TO
03300 PUSHJ P,EMINST ;PUT OUTPUT OF UNIT GEN. AWAY.
03400 PUSHJ P,EMDV ;MAKE ROOM IN VARIABLES AREA FOR IT.
03500 MOVE T,@CINST1 ;RETRIEVE PTR. TO RANDOM GOOD BITS.
03600 SKIPN A,-1(T) ;DOES UNIT GEN. HAVE I-TIME CODE?
03700 POPJ P, ;NO.
03800 PUSHJ P,EMIABS ;YUP. EMIT THE CALLING INSTR.
03900 HRRZ A,RLOC ;AS PARAMETER, GIVE IT A PTR. TO
04000 MOVEI B,RRELBT ;JUST AFTER THE MOVEM EMITTED
04100 PUSHJ P,EMICDI ;ABOVE.
04200 POPJ P,
04300
00100 CINS4: PUSHJ P,STMT1 ;ITS NOT A UNIT GEN. CALL.
00200 JRST CINS3 ;NO
00300 CINSE: SETZM IARR1 ;YES. ZERO THINGS.
00400 MOVE [XWD IARR1,IARR1+1]
00500 BLT IARR3-1
00600 MOVE A,[POPJ P,] ;PUT RETURN INSTR. AT END OF
00700 MOVEI B,0 ;THE I-TIME CODE.
00800 PUSHJ P,EMICDI
00900 PUSHJ P,EMCDI ;ALSO THE R-TIME CODE.
01000 CINSR1: PUSHJ P,SCAN
01100 JRST STATL1
01200
01300 ;; IF THE NAME OF A UNIT GENERATOR IS FOLLOWED BY AN
01400 ;; EXPRESSION IN SQUARE BRACKETS, THE U.G. GETS CALLED ONLY
01500 ;; EVERY N TIME STEPS, WHERE N IS THE VALUE OF THE EXPRESSION.
01600 ;; N IS RECALCULATED EVERY TIME THE U.G. IS CALLED.
01700
01800 CUG1: MOVE C,[AOSGE EMCDI] ;INSTR. TO COUNT NO. OF TIME STEPS TO SKIP THIS UG.
01900 MOVE B,VLOC ;GRAB LOCATION IN VARIABLE AREA TO HOLD COUNT OF TIME STEPS TO SKIP.
02000 MOVEI A,0 ;NO AC FIELD, PLEASE.
02100 PUSHJ P,EMINST ;EMIT THE AOSGE JUST AHEAD OF THE CODE TO CALL THE U.G.
02200 MOVE C,[SETZM EMICDI] ;ALSO EMIT AN INSTR. TO THE I-TIME
02300 MOVE B,VLOC ;CODE TO INIT. THE COUNTER LOCATION TO 0 (SO U.G. GETS CALLED FIRST TIME).
02400 PUSHJ P,EMINST
02500 PUSH P,RLOC ;SAVE R-TIME LOC. COUNTER (FOR LATER FIXUP TO JRST WE ARE ABOUT TO EMIT).
02600 PUSH P,VLOC ;ALSO VARIABLE LOC., FOR LATER LOADING OF THE STEPS-TO-SKIP COUNTER.
02700 PUSHJ P,EMDV ;MAKE A WORD FOR IT.
02800 MOVSI A,(<JRST>) ;NOW EMIT THE JUMP AROUND THE CALL OF
02900 PUSHJ P,EMCDI ;THE U.G. !!"" N.B.: B IS 0 HERE FROM CALL ON EMDV !!
03000 PUSHJ P,SEXPR ;NOW COMPILE THE EXPRESSION IN THE BRACKETS.
03100 CAME A,CTBL+"]" ;SHOULD BE FOLLOWED BY ONE...
03200 ERROR (MISSING ])
03300 MOVEI H,1 ;INDICATE THAT WE ARE WORKING WITH R-TIME CODE...
03400 PUSHJ P,GMURK1 ;..AND GET EXPR OFF OPERAND STACK.
03500 PUSHJ P,GG2 ;NOW GET IT INTO AN AC.
03600 MOVSI C,(<FIX>) ;EMIT INSTR. TO FIX VALUE OF EXPRESSION.
03700 MOVEI B,233000 ;MAGIC NO. FOR ADDRESS OF FIX, HO HO.
03800 PUSHJ P,EMINST
03900 POP P,B ;GET LOCATION IN VARIABLE AREA OF THE STEPS-TO-SKIP COUNTER.
04000 MOVSI C,(<MOVNM>) ;AND EMIT INSTR. TO STORE NEGATIVE OF COUNT THERE.
04100 PUSHJ P,EMINST
04200 PUSHJ P,CINS6 ;NOW COMPILE CALL ON UNIT GENERATOR.
04300 POP P,A ;RECOVER LOC. OF THE JRST UNDER THE AOSGE.
04400 MOVEI B,.FXBTS ;EMIT FIXUP TO MAKE IT POINT HERE (I.E., AFTER
04500 PUSHJ P,EMCD ; END OF U.G. CALL).
04600 JRST CINS5 ;ALL DONE.
04700
00100 ;; THE WONDERFUL, WINNING LOADER.
00200
00300 R←←1
00400 I←←2
00500 V←←3
00600
00700 LOADER: MOVE R,JOBFF ;R-TIME CODE RELOCATION CONST.
00800 HRRZ I,RLOC ;
00900 ADD I,R ;I-TIME CONST.
01000 HRRZ V,ILOC
01100 ADD V,I ;VARIABLE RELOC. CONST.
01200 MOVE T3,V
01300 ADD T3,VLOC ;PROGRAM BREAK.
01400 HRRZM T3,JOBFF
01500 HRLM T3,JOBSA ;MAKE SURE IT TAKES.
01600 HRL A,R ;ZERO THE PROGRAM AREA.
01700 HRRI A,1(R)
01800 SETZM (R)
01900 BLT A,-1(T3)
02000 MOVEI H,0 ;START WITH R-TIME CODE.
02100 LD1: ADDI H,1 ;GO TO NEXT CHAIN OF BUFFERS.
02200 CAILE H,3 ;ALL DONE ?
02300 POPJ P, ;YES.
02400 PUSH P,[LDL1] ;FAKE UP A RETURN TO LDL1.
02500 MOVE C,(H) ;INIT. THE CURRENT LOC. COUNTER.
02600 SKIPA F,FCBUF-1(H) ;PTR. TO FIRST BUF. OF CHAIN.
02700 LD2: HRRZ F,(F) ;PTR. TO NEXT BUF. OF CHAIN.
02800 HRRZ E,F ;SET UP BYTE PTR. TO RELOC. BITS.
02900 HRLI E,200
03000 HRRZI D,LOBUFS/12+2(F) ;PTR. TO DATA IN BUF.
03100 HRLI D,-<LOBUFS-LOBUFS/12-2> ;WORD COUNT.
03200 LDGW: AOBJP D,LD2 ;WORD COUNT EXHAUSTED ?
03300 MOVE (D) ;NO. PICK UP NEXT DATA WORD.
03400 ILDB A,E ;FIRST 2 REL. BITS.
03500 ILDB B,E ;LAST 2.
03600 POPJ P,
03700 LDL: PUSHJ P,LDGW ;GET NEXT WORD FROM BUFFER.
03800 LDL1: JUMPE A,LDF1 ;NO REL. GIVEN; MAY BE A FIXUP.
03900 JUMPE B,LDRST ;IF NEITHER HALF, THEN IT'S A RESET.
04000 PUSH P,CLD3 ;ANOTHER FAKE RETURN ADDRESS.
04100 LDRL1: TRNE B,1 ;RELOCATE RIGHT HALF ?
04200 ADD (A) ;YES.
04300 TRNN B,2 ;LEFT HALF ?
04400 POPJ P, ;NO.
04500 MOVSS (A)
04600 ADD (A)
04700 MOVSS (A)
04800 POPJ P,
04900 LD3: ADDM (C) ;PUT IN CORE.
05000 CLDL: AOJA C,LDL ;GET ANOTHER.
05100
00100 ;; MORE LOADER (BUT NOT MUCH MORE, YOU WILL NOTICE !).
00200
00300 LDF1:
00400 CLD3: JUMPE B,LD3 ;PERHAPS NOT A FIXUP.
00500 JUMPE LD1 ;IT MIGHT EVEN BE AN END MARK.
00600 LDB T3,[POINT 2,0,15] ;A FIXUP. GET REL. BITS FOR PTR.
00700 DPB T3,[POINT 5,0,17]
00800 PUSH P,0
00900 JUMPG LDF2 ;IS VALUE OF FIXUP TO BE FOUND IN BUFFER ?
01000 PUSHJ P,LDGW ;YES. GET IT.
01100 PUSHJ P,LDRL1 ;PERFORM ANY INDICATED RELOCATION ON IT.
01200 SKIPA T3,0 ;MOVE RELOCATED VALUE INTO T3.
01300 LDF2: MOVE T3,C ;VALUE IS CURRENT LOCATION.
01400 POP P,0 ;BRING BACK THE POINTER WORD.
01500 TLNE SWAPBT ;SHOULD WE EXCHANGE HALVES OF THE VALUE ?
01600 MOVSS T3 ;YES.
01700 TLNE RRFXBT ;SHOULD WE REPLACE THE RIGHT HALF OF THE LOCATION?
01800 HRRM T3,@0 ;YES. SEE THE POINTER RELOCATION HAPPEN AUTOMATICALLY!!
01900 TLNE LRFXBT ;REPLACE THE LEFT HALF ?
02000 HLLM T3,@0 ;YES.
02100 TLNN LRFXBT+RRFXBT ;IF NEITHER HALF REPLACED, THEN
02200 ADDM T3,@0 ;IT'S AN ADDITIVE FIXUP.
02300 JRST LDL ;BACK TO MAIN LOOP.
02400
02500 LDRST: HALT ;THE FEATURE YOU HAVE REQUESTED ...
02600
02700
02800
00100 DARR: PUSH P,[0] ;DEFINE SOME ARRAYS.
00200 DARR1: PUSHJ P,GETNAM ;SCAN NAME.
00300 XWD DF,SWVBT ;TYPE PARAMETER TO GETNAM.
00400 PUSH P,A ;STACK PTR. TO ENTRY.
00500 PUSHJ P,SCAN ;LOOK FOR COMMA.
00600 CAMN A,COMMAV ;IS IT ONE ?
00700 JRST DARR1 ;YES. GET MORE NAMES.
00800 CAME A,LPARV ;NO. SHOULD BE A (.
00900 ERROR(MISSING LEFT PAREN.)
01000 PUSHJ P,SCAN ;GET THE DIMENSION.
01100 TLNN A,NUMFLG ;MAKE SURE IT'S A NUMBER.
01200 ERROR(IMPROPER DIMENSION)
01300 MOVE B,(A) ;GET VALUE.
01400 TLNN A,FIXFLG ;IS IT FLOATING ?
01500 FIX B,233000
01600 DARR3: AOS JOBFF ;GET FREE STORAGE PTR.
01700 POP P,T ;PTR. TO NAME IN TABLE...
01800 JUMPE T,DARR2 ;UNLESS ITS THE MARK.
01900 JUMPG T,DARR4 ;WAS IT PREVIOUSLY DEFINED ?
02000 HRRZ T1,(T) ;YES. GET ITS BASE ADDRESS.
02100 CAMG B,-1(T1) ;IS NEW DIMENSION > OLD ?
02200 JRST DARR3 ;NO. LEAVE OLD DEFINITION ALONE.
02300 DARR4: AOS A,JOBFF ;INCREMENT FREE STG. PTR. AGAIN.
02400 HRRM A,(T) ;PUT IN SYM. TABLE.
02500 MOVEM B,-1(A) ;PUT DIMENSION IN -1TH ELEMENT.
02600 HRLI A,INSXR ;PUT GOOD INDEX FIELD IN A...
02700 MOVEM A,-2(A) ;PUT PTR. TO ARRAY WITH INDEX IN AR[-2]
02800 ADDM B,JOBFF ;INCREMENT IT.
02900 JRST DARR3 ;TRY FOR ANOTHER.
03000 DARR2: PUSHJ P,SCAN ;GET THE ).
03100 CAME A,RPARV
03200 ERROR(MISSING RIGHT PAREN.)
03300 PUSHJ P,SCAN
03400 CAMN A,COMMAV ;A COMMA ?
03500 JRST DARR ;YES. START OVER AGAIN.
03600 HRRZ JOBSYM ;LET'S FIND OUT IF WE'VE LOST...
03700 CAMG JOBFF ;IS TOP STILL ABOVE BOTTOM ?
03800 ERROR(STORAGE IS FULL)
03900 HRRZ JOBFF
04000 HRLM JOBSA
04100 JRST STATL1
04200
00100 ; HERE IS THE OUTER LOOP OF THE WHOLE SYSTEM.
00200
00300 CHOWN1: PUSHJ P,INTER1 ;INTERPRET STATEMENT.
00400 SCHOWN: PUSHJ P,SMSC1 ;GET FIRST NON-SEMICOLON.
00500 CHOWN: CAMN A,PLAYV ;IS IT A 'PLAY' SECTION ?
00600 JRST PLAY1 ;YES.
00700 CAMN A,ALTV ;IS IT AN ALT MODE ?
00800 JRST COMMND ;YES. A COMMAND FOLLOWS.
00900 CAME A, COMPV ;A 'COMPILE' SECTION ?
01000 JRST CHOWN1 ;NO. JUST A STATEMENT.
01100 PUSHJ P,SCOMP ;INIT. THE COMPILER.
01200 PUSHJ P,SSTATL ;COMPILE A STATEMENT LIST.
01300 PUSHJ P,LOADER ;LOAD THE CODE.
01400 JRST SCHOWN ;DONE WITH THAT SECTION.
01500
01600 PLAY1: PUSHJ P,GSBUF ;WE'RE GOING TO PLAY; GET SAMPLE BUFFER.
01700 AOS SBCNT
01800 PLAY1A: SETZM TIME# ;T←0.
01900 SETZM RQPTR# ;RUN QUEUE IS EMPTY.
02000 SETZM MAXSMP# ;INIT. THE MAXIMUM SAMPLE REMEMBERER.
02100 PLAY2: PUSHJ P,SMSC1 ;SCAN A NON-SEMICOLON.
02200 CAME A,FINV ;A 'FINISH ' ?
02300 CAMN A,PLAYV ;... OR A 'PLAY' ?
02400 JRST PTERM ;YES. END OF SECTION.
02500 TLNE A,INSBIT ;AN INSTRUMENT NAME ?
02600 JRST PINS ;YES. A NOTE STATEMENT.
02700 PUSH P,[EXP PLAY2] ;NO. INTERPRET THE STATEMENT.
02800 INTER1: CAME A,INSV
02900 CAMN A,FUNV
03000 ERROR (ILLEGAL 'PLAY' STATEMENT)
03100 PUSHJ P,SCOMPA ;IT MUST BE A RANDOM STATEMENT.
03200 ;PREPARE TO INTERPRET IT BY INITIALIZING
03300 ;THE COMPILER.
03400 PUSHJ P,STAT ;COMPILE THE STATEMENT.
03500
03600 INTERP: MOVE A,[JRST INTER2] ;PREPARE TO EXECUTE TEMPORARY
03700 MOVEI B,0 ;CODE (I.E,RUN IN INTERPRET MODE).
03800 PUSHJ P,EMICDI ;EMIT RETURN INSTR. AT END OF CODE.
03900 PUSHJ P,ENDP1 ;CLEAN UP COMPILER.
04000 PUSH P,JOBFF ;SAVE FREE STG. PTR.
04100 PUSHJ P,LOADER ;LOAD THE TEMPORARY CODE.
04200 MOVEM P,PSV1# ;SAVE IT.
04300 MOVEM FL,FLSV1#
04400 MOVE 17,P ;PTR. FOR (UGH! BLETCH!) FOOTRAN PGMS.
04500 JRST @(P) ;EXECUTE IT.
04600 INTER2: MOVE P,PSV1 ;RESTORE PUSHDOWN POINTER.
04700 MOVE FL,FLSV1
04800 POP P,0 ;RETRIEVE OLD STG. PTR.
04900 HRRZM JOBFF ;FLUSH THE TEMP. CODE.
05000 HRLM JOBSA ;(IT HAS TO GO HERE TOO.)
05100 POPJ P, ;LOOK, MA, I'M AN INTERPRETER !!
05200
05300
00100 ;THIS CODE READS A NOTE STATEMENT, INITIALIZES THE
00200 ; INSTRUMENT, AND GETS IT TURNED ON AT THE RIGHT TIME.
00300
00400 PINS: MOVE A,(A) ;GET STARTING ADDRESSES FOR INSTRUMENT.
00500 PUSH P,(A) ;SAVE THEM.
00600 MOVEI PBASE ;PREPARE TO FILL THE P ARRAY WITH
00700 MOVEM PPTR1# ;THE PARAMETERS TO THE INSTR.
00800 PUSHJ P,SCOMPA ;INIT. COMPLR. FOR POSSIBLE EXPRESSIONS.
00900 MOVE NCHNS ;GET NO. OF OUTPUT CHANNELS.
01000 TLNE -1 ;IS IT FLOATING ?
01100 FIX 233000
01200 PINS2: MOVEM NCHNS
01300 PUSH P,NUMBUC ;SAVE CURRENT STATE OF NUMBER
01400 PUSH P,JOBFF ;BUCKET AND CORE TOP.
01500 JRST PINSL ;INIT. THE COMPILER.
01600
01700
01800 PINSL1: CAMN A,COMMAV ;OPTIONAL COMMA BETWEEN PARAMS...
01900 PINSL: PUSHJ P,SCAN
02000 AOS PPTR1 ;INCREMENT P-ARRAY POINTER.
02100 CAMN A,COMMAV ;A COMMA HERE MEANS MISSING
02200 JRST PINSL ;PARAM., SO DON'T CHANGE.
02300 CAMN A,SEMICV ;SEMICOLON ?
02400 JRST PINSB ;YES, END OF PARAMETERS.
02500 PUSHJ P,EXPR ;PARAMETER MAY BE EXPRESSION.
02600 PUSHJ P,GPONDER ;GET OPERAND POINTER FOR THE EXPR...
02700 TLNE T,SIACBT ;IS VALUE OF EXPR AN AC SYMBOL ?
02800 JRST PINS1 ;YES. IT HAS TO BE CALCULATED.
02900 MOVE C,(T) ;PICK UP ITS VALUE.
03000 MOVEM C,@PPTR1 ; SO PUT ITS VALUE IN P-ARRAY NOW.
03100 JRST PINSL1
03200 PINS1: PUSH P,A ;EXPR. GENERATED SOME CODE, EVIDENTLY.
03300 MOVE A,T ;EMIT AN INSTRUCTION TO STORE THE
03400 MOVE B,PPTR1 ;RESULTANT VALUE IN THE P-ARRAY.
03500 MOVE C,[MOVEM EMICDI]
03600 PUSHJ P,EMINST ;THE CODE WILL GET EXECUTED
03700 PUSHJ P,INTERP ; RIGHT NOW.
03800 PUSHJ P,SCOMPA
03900 POP P,A
04000 JRST PINSL1 ;BACK FOR MORE PARAMS.
04100
00100 ;; MORE OF PINS.
00200
00300 PINSB: POP OSP,JOBSYM ;FLUSH COMPLR. OUTPUT BUFFERS.
00400 POP P,0 ;RECOVER OLD CORE TOP.
00500 MOVEM JOBFF ;RESET THINGS TO FORGET
00600 HRLM JOBSA ;ABOUT THE NUMBERS WE DEFINED WHILE
00700 POP P,NUMBUC ;SCANNING NOTE PARAMETERS.
00800 MOVE A,SRATE ;GET NO. OF SAMPLES/SEC.
00900 FDVR A,TIMESC ;DIVIDE BY BEATS/SEC.
01000 MOVE B,PBASE+1 ;GET STARTING TIME FOR NOTE.
01100 FMPR B,A ;CONVERT TO SAMPLES.
01200 FADR B,[0.5]
01300 FIX B,233000
01400 MOVEM B,RQ1 ;PLACE AT BOTTOM OF RUN QUEUE.
01500 FMPR A,PBASE+2 ;GET DURATION OF NOTE IN SAMPLES.
01600 FADR A,[0.5]
01700 FIX A,233000
01800 ADD A,B ;CALC. ENDING TIME OF NOTE.
01900 PUSH P,A ;SAVE SAME.
02000 PUSHJ P,PLAYIT ;PLAY UP TO STARTING TIME OF NOTE.
02100 PLYON: AOS A,RQPTR ;NOW TURN INSTRUMENT ON.
02200 POP P,RQ1(A) ;PUT ENDING TIME IN RUNQUEUE, COL. ONE.
02300 POP P,T ;GET STARTING ADDR. OF INSTRUMENT.
02400 HLRZM T,RQ2(A) ;PLACE IN RUN QUEUE, COL. TWO.
02500 PUSHJ P,(T) ;EXECUTE THE I-TIME CODE.
02600 JRST PLAY2 ;BACK FOR MORE NOTE STATEMENTS.
02700
02800 PTERM: PUSH P,A ;HERE AT A 'PLAY' OR 'FINISH'.
02900 MOVSI 200000
03000 MOVEM RQ1 ;SET UP FAKE STARTING TIME.
03100 PUSHJ P,PLAYIT ;FLUSH THE RUN QUEUE.
03200 POP P,A
03300 CAMN A,PLAYV ;WAS IT A 'PLAY' THAT WE SAW ?
03400 JRST PLAY1A ;YES. START NEW SECTION.
03500 PUSHJ P,OSBUF ;NO, A 'FINISH'. EMPTY THE
03600 JRST SCHOWN ;SAMPLE BUFFER AND START OVER.
03700
00100 ;; THIS ROUTINE GENERATES SAMPLES BY CALLING THE
00200 ;; INSTRUMENTS IN THE RUN QUEUE UNTIL IT IS TIME
00300 ;; TO TURN ON THE INSTRUMENT WHOSE STARTING TIME IS
00400 ;; IN THE ZEROTH LOCATION OF THE QUEUE, WHEN IT RETURNS.
00500 ;; INSTRUMENTS ARE TURNED OFF AS REQUIRED.
00600
00700 PLAYIT: MOVE A,RQPTR ;SEARCH FOR EARLIEST TIME IN QUEUE.
00800 PLYT2: MOVEM A,PTMP# ;SAVE ITS LOCATION.
00900 SKIPA H,RQ1(A) ;PICK IT UP.
01000 CAMG H,RQ1(A) ;A NEW MINIMUM ?
01100 SOJGE A,.-1 ;NO.
01200 JUMPGE A,PLYT2 ;YES.
01300 PLYT1: CAMN H,[XWD 200000,0] ;MIN. FOUND. IS IT THE TERMINATION
01400 POPJ P, ; MARK ? IF YES, THEN RETURN.
01500 SUB H,TIME ;IT'S NOT . CALC. DISTANCE IN FUTURE.
01600 JUMPLE H,PLYT3 ;IF NOT IN FUTURE, FORGET IT.
01700 ADDM H,TIME ;MOVE TIME TO NEW VALUE.
01800 PLYT4: SKIPE OSP,RQPTR ;CYCLE THRU RUNNING INSTRS., IF ANY.
01900 PUSHJ P,@RQ2(OSP) ;CALL AN INSTR.
02000 JFCL 1,.+1 ;THIS AND NEXT FROM JC,MUS. WHY???
02100 SOJG OSP,.-2 ;CALL THEM ALL.
02200 ;;;; SOJG OSP,.-1 ;CALL THEM ALL.
02300 MOVEI F,1 ;START WITH CHANNEL 1.
02400 PLYT5: SOSG SBCNT ;COUNT SAMPLE BUFFER COUNTER.
02500 PUSHJ P,FSBUF ;FLUSH FULL BUFFER.
02600 MOVEI B,0 ;PICK UP NEXT CHANNEL'S SAMPLE, AND
02700 EXCH B,OUTA-1(F) ; ZERO THE LOCATION.
02800 FAD B,[0.5] ;ROUND TO NEAREST INTEGER.
02900 FIX B,233000 ;A. KOTOK SHOULD HAVE DONE THIS.
03000 MOVM A,B ;GET MAGNITUDE...
03100 CAMLE A,MAXSMP ;IS THIS SAMPLE THE BIGGEST YET ?
03200 MOVEM A,MAXSMP ;YUP.
03300 IDPB B,SBPTR ;PLACE IT IN SAMPLE BUFFER.
03400 CAMGE F,NCHNS ;LAST CHANNEL ?
03500 AOJA F,PLYT5 ;NO. GET OTHER CHANNELS.
03600 SOJG H,PLYT4 ;GENERATE REST OF SAMPLES.
03700
03800 PLYT3: SKIPG A,PTMP ;GET PTR. TO NEXT INSTR. OFF OR ON.
03900 POPJ P, ;TIME TO TURN ONE ON.
04000 SOS B,RQPTR ;REMOVE INSTR. FROM QUEUE.
04100 MOVE RQ1+1(B) ;MOVE TOP ENTRY DOWN INTO VACANT
04200 MOVEM RQ1(A) ;SPOT.
04300 MOVE RQ2+1(B)
04400 MOVEM RQ2(A)
04500 JRST PLAYIT ;GO PLAY TILL NEXT EVENT.
04600
04700
00100 ;; RANDOM ROUTINES TO HANDLE THE SAMPLE OUTPUT BUFFER.
00200
00300 GSBUF: HRRZ T,JOBSYM ;GET A SAMPLE BUFFER.
00400 SUB T,JOBFF ;HOW MUCH ROOM IS LEFT ?
00500 SUBI T,4*LOBUFS ;(ALLOWING ROOM FOR CODE BUFFERS)
00600 SKIPN BIGBIT ;SETS LSBUF TO 1024 IF EITHER BIGBIT OR RCDFLG!
00700 SKIPE RCDFLG
00800 SKIPA
00900 JRST GSBUF1 ;1023 IS FOR DEFERRED LONGPLAY
01000 CAIGE T,=1024 ;1024 IS FOR IMMEDIATE LONGPLAY WITH 'PLAY'
01100 ERROR (ADD 1K OF CORE!)
01200 MOVEI T,=1023
01300 SKIPGE RCDFLG ;IS IT POSITIVE OR ZERO?
01400 MOVEI T,=1024 ;NO, RCDFLG←-1; IS FOR IMMEDIATE LONGPLAY
01500 GSBUF1: MOVEM T,LSBUF ;PUT AWAY.
01600 MOVNS T
01700 PUSHJ P,GFS ;GRAB ENOUGH FREE STORAGE...
01800 HRRZM T,SBBOTT# ;SAVE PTR. TO BUFFER.
01900 FSBUF2: HRLI T,441400 ;MAKE BYTE POINTER.
02000 ;****************************************************
02100 SKIPE BIGBIT ;IS IT 18 BIT?
02200 HRLI T,442200 ;YES. RESET BYTE SIZE
02300 MOVEM T,SBPTR# ;
02400 MOVE T,LSBUF ;GET LENGTH OF BUFFER.
02500 ASH T,1 ;SAMPLE CT = LSBUF *2 FOR 18 BIT
02600 SKIPN BIGBIT ;IS IT 18 BIT?
02700 ADD T,LSBUF ;NO, MAKE * 3.
02800 MOVEM T,SBCNT#
02900 POPJ P,
03000
03100 OSBUF: HRRZ LSBUF ;THROW OUT SAMPLE BUFFER...
03200 ADDM JOBSYM
03300 MOVEI 0
03400 SKIPA T,SBCNT
03500 IDPB 0,SBPTR
03600 SOJG T,.-1
03700 JRST FSBUF
03800
03900 SMPOUT: MOVE SBBOTT
04000 MOVEM IBOTT
04100 ; MAR 16,71 MOVE BIGBIT
04200 ; MAR 16,71 MOVEM IBIT#
04300 JSA 16, SMPLS ;CALL WRITING ROUTINE
04400 JUMP LSBUF
04500 JUMP SBCNT
04600 IBOTT: 0
04700 JUMP MAXSMP
04800 ; MAR 16,71 JUMP IBIT
04900 JUMP BIGBIT
05000 JUMP RCDFLG ;RCDFLG←-1 WRITES ONE LONG .DMD FILE 6/71
05100 SKIPN BIGBIT
05200 SKIPE RCDFLG ;RCDFLG ON?
05300 SKIPE DOPLAY ;PLAY ANYWAY?
05400 JRST FSBUF1 ;GO TO PLAY
05500 JRST FSBF2A ;DOESN'T PLAY
05600
05700
05800 FSBUF: SKIPN BIGBIT
05900 SKIPE RCDFLG# ;OUTPUT TO DISC?
06000 JRST SMPOUT
06100 FSBUF1: HRR SBBOTT ;CALCULATE NEGATIVE WORD COUNT.
06200 SUB SBPTR
06300 SUBI 1 ;PREVENT 0 WORD COUNTS.
06400 HRRZ T,SBBOTT ;GET BOTTOM OF BUFFER....
06500 HRLI -1(T) ; MINUS ONE.
06600 MOVSM OUTWC ;PUT IOWD IN RIGHT PLACE.
06700 MOVSM SOUTWC# ;SAVE FOR $P
06800 INTERN OUTWC
06900 EXTERN IMMPLY
07000 INTERN NCHNS
07100 INTERN SPEED
07200 JSA 16,IMMPLY
07300 FSBF2A: MOVE T,SBBOTT ;NOW SET UP POINTERS AGAIN.
07400 JRST FSBUF2
07500
07600 OUTWC: 0
07700 ; 3650 ;MAGIC BITS FOR 136.
07800 0
07900 OUTBIT: 4000 ;BITS FOR A-D.
08000 BLOCK 2
08100
00100 ;; ERROR HANDLING(?) ROUTINES.
00200
00300 ERR1: 0 ;HERE FROM UUO TRAP.
00400 TLNE FL,ERRFLG ;IN ERROR SKIPPING MODE ?
00500 JRST 2,@ERR1 ;YES.
00600 MOVEM 17,ERSVAC+17 ;NO. SAVE ACS.
00700 MOVEI 17,ERSVAC
00800 BLT 17,ERSVAC+16
00900 JSR ERR2 ;PRINT MESSAGE.
01000 MOVSI 17,ERSVAC ;RESTORE AC'S.
01100 BLT 17,17
01200 ERRX: TLO FL,ERRFLG ;ENTER ERROR-SKIPPING MODE.
01300 RELEAS TTY,0
01400 RELEAS DT,0
01500 PUSHJ P,SETUP1
01600 JRST GOB
01700 JRST 2,@ERR1 ;TRY TO CONTINUE (HO, HO.).
01800
01900 ERSVAC: BLOCK 20
02000
02100 ERR2: 0 ;ERROR MESSAGE PRINTER.
02200 HRRZI [ASCIZ /
02300 $$$ ERROR: /]
02400 JSR TXTOUT
02500 HRRZ 40
02600 JSR TXTOUT
02700 HRRZI [ASCIZ /
02800 /]
02900 JSR TXTOUT
03000 MOVE A,ISCP
03100 MOVE B,A
03200 MOVE C,B
03300 ERR2B: ILDB A
03400 CAIE 15
03500 JRST ERR2A
03600 MOVE C,B
03700 MOVE B,A
03800 ERR2A: CAME A,SCP
03900 JRST ERR2B
04000 JRST ERR2D
04100 ERR2C: SOSGE TOB+2
04200 OUTPUT TTY,0
04300 IDPB TOB+1
04400 ERR2D: ILDB C
04500 CAME C,SCP
04600 JRST ERR2C
04700 SKIPN SNCHR
04800 IDPB TOB+1
04900 OUTPUT TTY,0
05000 JRST @ERR2
05100
05200
05300
00100
00200 SYMSCH: MOVEI T,6 ;LOOK UP EXTERNAL SYMBOL.
00300 MOVE [POINT 6,ACCUM,5] ;PREPARE TO CONVERT TO
00400 MOVEI B,0
00500 SYMS1: ILDB A,0 ;RADIX 50.
00600 JUMPE A,SYMS4
00700 CAIN A,16
00800 MOVEI A,73
00900 CAIG A,5
01000 ADDI A,70
01100 CAIGE A,32
01200 ADDI A,7
01300 IMULI B,50
01400 ADDI B,-26(A)
01500 SOJG T,SYMS1
01600 SYMS4: TLO B,40000
01700 MOVE A,116
01800 SYMS3: AOBJP A,SYMS2
01900 CAME B,-1(A)
02000 AOBJN A,SYMS3
02100 SYMS2: SKIPL A
02200 SKIPA A,[EXP NX]
02300 HRRZ A,(A)
02400 POPJ P,
02500
02600 NX: 0
02700 ERROR (MISSING EXTERNAL FUNCTION)
02800 JRST INTER2
02900
03000
03100 INTERNAL RDNUM,MESS,PNUM
03200
03300 EXTERNAL JOBDDT;
03400 PNUM: 0
03500 MOVE P,JOBFF
03600 SKIPGE A,@(RA)
03700 OUTCHR ["-"]
03800 MOVMS A
03900 PUSHJ P,DECPNT
04000 OUTPUT TTY,0
04100 JRA RA,1(RA)
04200
00100 RDNUM: 0 ;NUMBER READER FOR FOOTRAN ROUTINES.
00200 MOVE P,JOBFF ;GET TEMP. PDL
00300 EXCH FL,FLSV1
00400 RDNUM1: TLO FL,SNUMF1
00500 PUSHJ P,SCAN
00600 CAMN A,MINV ;A MINUS SIGN ?
00700 TLOA FL,MINFLG ;YES. SET FLAG AND LOOP BACK.
00800 TLNN A,NUMFLG ;IT IS A NUMBER, ISN'T IT ?
00900 JRST RDNUM1 ;NO. IGNORE IT.
01000 TLZE FL,MINFLG ;YES. HAVE WE SEEN A MINUS LATELY ?
01100 MOVNS C ;YES.
01200 MOVEM C,@(RA) ;PUT VALUE INTO PARAMETER.
01300 EXCH FL,FLSV1
01400 JRA RA,1(RA) ;RETURN TO (UGH ! BLETCH !) FOOTRAN.
01500 MESS: 0 ;MESSAGE PRINTER FOR FOOTRAN ROUTINES.
01600 HRRZ (RA) ;GET LOC. OF MESSAGE.
01700 CALLI 3
01800 JRA RA,1(RA)
01900 FOOPRT: 0
02000 MOVM A,@(RA)
02100 TLNE A,777000
02200 FIX A,233000
02300 PUSHJ P,DECPNT
02400 OUTPUT TTY,0
02500 JRST 1(RA)
02600
02700 COMMND: MOVEI [ASCII /$/]
02800 CALLI 3
02900 PUSHJ P,SCANNS ;GET COMMAND.
03000 JUMPL A,COMND1
03100 MOVE ACCUM
03200 MOVE 1,ACCUM+1
03300 LSHC 6
03400 CAMN [SIXBIT /RESET/]
03500 JRST REST1
03600 CAMN [SIXBIT /PRINT/]
03700 JRST CPNT ;A 'PRINT' COMMAND.
03800 CAMN [SIXBIT /P/]
03900 JRST CPLX
04000 CAMN [SIXBIT /DDT/]
04100 JRST @JOBDDT
04200 COMND1: MOVEI [ASCIZ /?? /]
04300 CALLI 3
04400 JRST SCHOWN
04500 CPLX: PUSHJ P,CGNUM ;GET FOLLOWING NUMBER, IF ANY.
04600 MOVEI T,1 ;NO NUMBER. TAKE AS 1.
04700 CPLAY:
04800 MOVEM T,NVST#
04900 MOVE T,SOUTWC
05000 MOVEM T,OUTWC
05100 JSA 16,IMMPLY
05200 MOVE T,NVST
05300 SOJG T,CPLAY ;REPEAT AS INDICATED BY ARGUMENT.
05400 JRST SCHOWN
05500
00100 REST1: MOVEI TEMPSY
00200 MOVEM BUCTBL
00300 JRST GO
00400
00500 ;MORE COMMAND ROUTINES.
00600
00700 CPNT: PUSHJ P,SCOMPA ;INIT. THE COMPILER.
00800 PUSH OSP,[XWD VRBLBT,[XWD VRBLBT,CPNTX#]] ;PUT FAKE VARIABLE IN STACK.
00900 PUSHJ P,ASTMT1 ;COMPILE RIGHT PART OF AN ASSIGNENT STATEMENT.
01000 PUSHJ P,INTERP ;EXECUTE THE CODE.
01100 SKIPL CPNTX ;'-'??
01200 JRST NOMIN
01300 MOVEI A,55
01400 SOSGE TOB+2
01500 OUTPUT TTY,0
01600 IDPB A,TOB+1
01700 NOMIN: MOVM A,CPNTX ;GET ITS VALUE.
01800 TLNE A,377000 ;ASSUMING ITS >0, IS IT FLOATING?
01900 FIX A,233000
02000 CPNT2: PUSHJ P,DECPNT ;PRINT IT.
02100 OUTPUT TTY,0
02200 POP P,A ;GET THING WHICH TERMINATED EXPR. (LEFT ON STACK BY ASTMT1).
02300 CAMN A,SEMICV ;A SEMICOLON ?
02400 JRST SCHOWN ;YES. FORGET IT.
02500 JRST CHOWN ;NO. LOOK AT IT.
02600
02700
02800 CGNUM: TLO FL,SNUMF1 ;DONT PUT NO.'S IN TABLE.
02900 PUSHJ P,SCAN ;LOOK FOR (OPTIONAL) NUMERIC ARGUMENT.
03000 TLNN A,NUMFLG ;IS THERE ONE ?
03100 POPJ P, ;NO.
03200 MOVE T,C ;YES. GET VALUE.
03300 TLNN A,FIXFLG ;IS IT FLOATING ?
03400 FIX T,233000 ;NOT ANY MORE.
03500 CGNUM2: POP P,T1 ;GET RETURN ADDR.
03600 JRST 1(T1) ;SKIP ON RETURN.
03700 END GO